1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P R J . P P -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with Ada.Characters.Handling; use Ada.Characters.Handling; 27 28with Output; use Output; 29with Snames; 30 31package body Prj.PP is 32 33 use Prj.Tree; 34 35 Not_Tested : array (Project_Node_Kind) of Boolean := (others => True); 36 37 procedure Indicate_Tested (Kind : Project_Node_Kind); 38 -- Set the corresponding component of array Not_Tested to False. Only 39 -- called by Debug pragmas. 40 41 --------------------- 42 -- Indicate_Tested -- 43 --------------------- 44 45 procedure Indicate_Tested (Kind : Project_Node_Kind) is 46 begin 47 Not_Tested (Kind) := False; 48 end Indicate_Tested; 49 50 ------------------ 51 -- Pretty_Print -- 52 ------------------ 53 54 procedure Pretty_Print 55 (Project : Prj.Tree.Project_Node_Id; 56 In_Tree : Prj.Tree.Project_Node_Tree_Ref; 57 Increment : Positive := 3; 58 Eliminate_Empty_Case_Constructions : Boolean := False; 59 Minimize_Empty_Lines : Boolean := False; 60 W_Char : Write_Char_Ap := null; 61 W_Eol : Write_Eol_Ap := null; 62 W_Str : Write_Str_Ap := null; 63 Backward_Compatibility : Boolean; 64 Id : Prj.Project_Id := Prj.No_Project; 65 Max_Line_Length : Max_Length_Of_Line := 66 Max_Length_Of_Line'Last) 67 is 68 procedure Print (Node : Project_Node_Id; Indent : Natural); 69 -- A recursive procedure that traverses a project file tree and outputs 70 -- its source. Current_Prj is the project that we are printing. This 71 -- is used when printing attributes, since in nested packages they 72 -- need to use a fully qualified name. 73 74 procedure Output_Attribute_Name (Name : Name_Id; Indent : Natural); 75 -- Outputs an attribute name, taking into account the value of 76 -- Backward_Compatibility. 77 78 procedure Output_Name 79 (Name : Name_Id; 80 Indent : Natural; 81 Capitalize : Boolean := True); 82 -- Outputs a name 83 84 procedure Start_Line (Indent : Natural); 85 -- Outputs the indentation at the beginning of the line 86 87 procedure Output_Project_File (S : Name_Id); 88 -- Output a project file name in one single string literal 89 90 procedure Output_String (S : Name_Id; Indent : Natural); 91 -- Outputs a string using the default output procedures 92 93 procedure Write_Empty_Line (Always : Boolean := False); 94 -- Outputs an empty line, only if the previous line was not empty 95 -- already and either Always is True or Minimize_Empty_Lines is False. 96 97 procedure Write_Line (S : String); 98 -- Outputs S followed by a new line 99 100 procedure Write_String 101 (S : String; 102 Indent : Natural; 103 Truncated : Boolean := False); 104 -- Outputs S using Write_Str, starting a new line if line would become 105 -- too long, when Truncated = False. When Truncated = True, only the 106 -- part of the string that can fit on the line is output. 107 108 procedure Write_End_Of_Line_Comment (Node : Project_Node_Id); 109 -- Needs comment??? 110 111 Write_Char : Write_Char_Ap := Output.Write_Char'Access; 112 Write_Eol : Write_Eol_Ap := Output.Write_Eol'Access; 113 Write_Str : Write_Str_Ap := Output.Write_Str'Access; 114 -- These three access to procedure values are used for the output 115 116 Last_Line_Is_Empty : Boolean := False; 117 -- Used to avoid two consecutive empty lines 118 119 Column : Natural := 0; 120 -- Column number of the last character in the line. Used to avoid 121 -- outputting lines longer than Max_Line_Length. 122 123 First_With_In_List : Boolean := True; 124 -- Indicate that the next with clause is first in a list such as 125 -- with "A", "B"; 126 -- First_With_In_List will be True for "A", but not for "B". 127 128 --------------------------- 129 -- Output_Attribute_Name -- 130 --------------------------- 131 132 procedure Output_Attribute_Name (Name : Name_Id; Indent : Natural) is 133 begin 134 if Backward_Compatibility then 135 case Name is 136 when Snames.Name_Spec => 137 Output_Name (Snames.Name_Specification, Indent); 138 139 when Snames.Name_Spec_Suffix => 140 Output_Name (Snames.Name_Specification_Suffix, Indent); 141 142 when Snames.Name_Body => 143 Output_Name (Snames.Name_Implementation, Indent); 144 145 when Snames.Name_Body_Suffix => 146 Output_Name (Snames.Name_Implementation_Suffix, Indent); 147 148 when others => 149 Output_Name (Name, Indent); 150 end case; 151 152 else 153 Output_Name (Name, Indent); 154 end if; 155 end Output_Attribute_Name; 156 157 ----------------- 158 -- Output_Name -- 159 ----------------- 160 161 procedure Output_Name 162 (Name : Name_Id; 163 Indent : Natural; 164 Capitalize : Boolean := True) 165 is 166 Capital : Boolean := Capitalize; 167 168 begin 169 if Column = 0 and then Indent /= 0 then 170 Start_Line (Indent + Increment); 171 end if; 172 173 Get_Name_String (Name); 174 175 -- If line would become too long, create new line 176 177 if Column + Name_Len > Max_Line_Length then 178 Write_Eol.all; 179 Column := 0; 180 181 if Indent /= 0 then 182 Start_Line (Indent + Increment); 183 end if; 184 end if; 185 186 for J in 1 .. Name_Len loop 187 if Capital then 188 Write_Char (To_Upper (Name_Buffer (J))); 189 else 190 Write_Char (Name_Buffer (J)); 191 end if; 192 193 if Capitalize then 194 Capital := 195 Name_Buffer (J) = '_' 196 or else Is_Digit (Name_Buffer (J)); 197 end if; 198 end loop; 199 200 Column := Column + Name_Len; 201 end Output_Name; 202 203 ------------------------- 204 -- Output_Project_File -- 205 ------------------------- 206 207 procedure Output_Project_File (S : Name_Id) is 208 File_Name : constant String := Get_Name_String (S); 209 210 begin 211 Write_Char ('"'); 212 213 for J in File_Name'Range loop 214 if File_Name (J) = '"' then 215 Write_Char ('"'); 216 Write_Char ('"'); 217 else 218 Write_Char (File_Name (J)); 219 end if; 220 end loop; 221 222 Write_Char ('"'); 223 end Output_Project_File; 224 225 ------------------- 226 -- Output_String -- 227 ------------------- 228 229 procedure Output_String (S : Name_Id; Indent : Natural) is 230 begin 231 if Column = 0 and then Indent /= 0 then 232 Start_Line (Indent + Increment); 233 end if; 234 235 Get_Name_String (S); 236 237 -- If line could become too long, create new line. Note that the 238 -- number of characters on the line could be twice the number of 239 -- character in the string (if every character is a '"') plus two 240 -- (the initial and final '"'). 241 242 if Column + Name_Len + Name_Len + 2 > Max_Line_Length then 243 Write_Eol.all; 244 Column := 0; 245 246 if Indent /= 0 then 247 Start_Line (Indent + Increment); 248 end if; 249 end if; 250 251 Write_Char ('"'); 252 Column := Column + 1; 253 Get_Name_String (S); 254 255 for J in 1 .. Name_Len loop 256 if Name_Buffer (J) = '"' then 257 Write_Char ('"'); 258 Write_Char ('"'); 259 Column := Column + 2; 260 else 261 Write_Char (Name_Buffer (J)); 262 Column := Column + 1; 263 end if; 264 265 -- If the string does not fit on one line, cut it in parts and 266 -- concatenate. 267 268 if J < Name_Len and then Column >= Max_Line_Length then 269 Write_Str (""" &"); 270 Write_Eol.all; 271 Column := 0; 272 Start_Line (Indent + Increment); 273 Write_Char ('"'); 274 Column := Column + 1; 275 end if; 276 end loop; 277 278 Write_Char ('"'); 279 Column := Column + 1; 280 end Output_String; 281 282 ---------------- 283 -- Start_Line -- 284 ---------------- 285 286 procedure Start_Line (Indent : Natural) is 287 begin 288 if not Minimize_Empty_Lines then 289 Write_Str ((1 .. Indent => ' ')); 290 Column := Column + Indent; 291 end if; 292 end Start_Line; 293 294 ---------------------- 295 -- Write_Empty_Line -- 296 ---------------------- 297 298 procedure Write_Empty_Line (Always : Boolean := False) is 299 begin 300 if (Always or else not Minimize_Empty_Lines) 301 and then not Last_Line_Is_Empty 302 then 303 Write_Eol.all; 304 Column := 0; 305 Last_Line_Is_Empty := True; 306 end if; 307 end Write_Empty_Line; 308 309 ------------------------------- 310 -- Write_End_Of_Line_Comment -- 311 ------------------------------- 312 313 procedure Write_End_Of_Line_Comment (Node : Project_Node_Id) is 314 Value : constant Name_Id := End_Of_Line_Comment (Node, In_Tree); 315 316 begin 317 if Value /= No_Name then 318 Write_String (" --", 0); 319 Write_String (Get_Name_String (Value), 0, Truncated => True); 320 end if; 321 322 Write_Line (""); 323 end Write_End_Of_Line_Comment; 324 325 ---------------- 326 -- Write_Line -- 327 ---------------- 328 329 procedure Write_Line (S : String) is 330 begin 331 Write_String (S, 0); 332 Last_Line_Is_Empty := False; 333 Write_Eol.all; 334 Column := 0; 335 end Write_Line; 336 337 ------------------ 338 -- Write_String -- 339 ------------------ 340 341 procedure Write_String 342 (S : String; 343 Indent : Natural; 344 Truncated : Boolean := False) 345 is 346 Length : Natural := S'Length; 347 348 begin 349 if Column = 0 and then Indent /= 0 then 350 Start_Line (Indent + Increment); 351 end if; 352 353 -- If the string would not fit on the line, start a new line 354 355 if Column + Length > Max_Line_Length then 356 if Truncated then 357 Length := Max_Line_Length - Column; 358 359 else 360 Write_Eol.all; 361 Column := 0; 362 363 if Indent /= 0 then 364 Start_Line (Indent + Increment); 365 end if; 366 end if; 367 end if; 368 369 Write_Str (S (S'First .. S'First + Length - 1)); 370 Column := Column + Length; 371 end Write_String; 372 373 ----------- 374 -- Print -- 375 ----------- 376 377 procedure Print (Node : Project_Node_Id; Indent : Natural) is 378 begin 379 if Present (Node) then 380 case Kind_Of (Node, In_Tree) is 381 when N_Project => 382 pragma Debug (Indicate_Tested (N_Project)); 383 if Present (First_With_Clause_Of (Node, In_Tree)) then 384 385 -- with clause(s) 386 387 First_With_In_List := True; 388 Print (First_With_Clause_Of (Node, In_Tree), Indent); 389 Write_Empty_Line (Always => True); 390 end if; 391 392 Print (First_Comment_Before (Node, In_Tree), Indent); 393 Start_Line (Indent); 394 395 case Project_Qualifier_Of (Node, In_Tree) is 396 when Unspecified | Standard => 397 null; 398 when Aggregate => 399 Write_String ("aggregate ", Indent); 400 when Aggregate_Library => 401 Write_String ("aggregate library ", Indent); 402 when Library => 403 Write_String ("library ", Indent); 404 when Configuration => 405 Write_String ("configuration ", Indent); 406 when Abstract_Project => 407 Write_String ("abstract ", Indent); 408 end case; 409 410 Write_String ("project ", Indent); 411 412 if Id /= Prj.No_Project then 413 Output_Name (Id.Display_Name, Indent); 414 else 415 Output_Name (Name_Of (Node, In_Tree), Indent); 416 end if; 417 418 -- Check if this project extends another project 419 420 if Extended_Project_Path_Of (Node, In_Tree) /= No_Path then 421 Write_String (" extends ", Indent); 422 423 if Is_Extending_All (Node, In_Tree) then 424 Write_String ("all ", Indent); 425 end if; 426 427 Output_Project_File 428 (Name_Id (Extended_Project_Path_Of (Node, In_Tree))); 429 end if; 430 431 Write_String (" is", Indent); 432 Write_End_Of_Line_Comment (Node); 433 Print 434 (First_Comment_After (Node, In_Tree), Indent + Increment); 435 Write_Empty_Line (Always => True); 436 437 -- Output all of the declarations in the project 438 439 Print (Project_Declaration_Of (Node, In_Tree), Indent); 440 Print 441 (First_Comment_Before_End (Node, In_Tree), 442 Indent + Increment); 443 Start_Line (Indent); 444 Write_String ("end ", Indent); 445 446 if Id /= Prj.No_Project then 447 Output_Name (Id.Display_Name, Indent); 448 else 449 Output_Name (Name_Of (Node, In_Tree), Indent); 450 end if; 451 452 Write_Line (";"); 453 Print (First_Comment_After_End (Node, In_Tree), Indent); 454 455 when N_With_Clause => 456 pragma Debug (Indicate_Tested (N_With_Clause)); 457 458 -- The with clause will sometimes contain an invalid name 459 -- when we are importing a virtual project from an extending 460 -- all project. Do not output anything in this case. 461 462 if Name_Of (Node, In_Tree) /= No_Name 463 and then String_Value_Of (Node, In_Tree) /= No_Name 464 then 465 if First_With_In_List then 466 Print (First_Comment_Before (Node, In_Tree), Indent); 467 Start_Line (Indent); 468 469 if Non_Limited_Project_Node_Of (Node, In_Tree) = 470 Empty_Node 471 then 472 Write_String ("limited ", Indent); 473 end if; 474 475 Write_String ("with ", Indent); 476 end if; 477 478 -- Output the project name without concatenation, even if 479 -- the line is too long. 480 481 Output_Project_File (String_Value_Of (Node, In_Tree)); 482 483 if Is_Not_Last_In_List (Node, In_Tree) then 484 Write_String (", ", Indent); 485 First_With_In_List := False; 486 487 else 488 Write_String (";", Indent); 489 Write_End_Of_Line_Comment (Node); 490 Print (First_Comment_After (Node, In_Tree), Indent); 491 First_With_In_List := True; 492 end if; 493 end if; 494 495 Print (Next_With_Clause_Of (Node, In_Tree), Indent); 496 497 when N_Project_Declaration => 498 pragma Debug (Indicate_Tested (N_Project_Declaration)); 499 500 if 501 Present (First_Declarative_Item_Of (Node, In_Tree)) 502 then 503 Print 504 (First_Declarative_Item_Of (Node, In_Tree), 505 Indent + Increment); 506 Write_Empty_Line (Always => True); 507 end if; 508 509 when N_Declarative_Item => 510 pragma Debug (Indicate_Tested (N_Declarative_Item)); 511 Print (Current_Item_Node (Node, In_Tree), Indent); 512 Print (Next_Declarative_Item (Node, In_Tree), Indent); 513 514 when N_Package_Declaration => 515 pragma Debug (Indicate_Tested (N_Package_Declaration)); 516 Write_Empty_Line (Always => True); 517 Print (First_Comment_Before (Node, In_Tree), Indent); 518 Start_Line (Indent); 519 Write_String ("package ", Indent); 520 Output_Name (Name_Of (Node, In_Tree), Indent); 521 522 if Project_Of_Renamed_Package_Of (Node, In_Tree) /= 523 Empty_Node 524 then 525 Write_String (" renames ", Indent); 526 Output_Name 527 (Name_Of 528 (Project_Of_Renamed_Package_Of (Node, In_Tree), 529 In_Tree), 530 Indent); 531 Write_String (".", Indent); 532 Output_Name (Name_Of (Node, In_Tree), Indent); 533 Write_String (";", Indent); 534 Write_End_Of_Line_Comment (Node); 535 Print (First_Comment_After_End (Node, In_Tree), Indent); 536 537 else 538 Write_String (" is", Indent); 539 Write_End_Of_Line_Comment (Node); 540 Print (First_Comment_After (Node, In_Tree), 541 Indent + Increment); 542 543 if First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node 544 then 545 Print 546 (First_Declarative_Item_Of (Node, In_Tree), 547 Indent + Increment); 548 end if; 549 550 Print (First_Comment_Before_End (Node, In_Tree), 551 Indent + Increment); 552 Start_Line (Indent); 553 Write_String ("end ", Indent); 554 Output_Name (Name_Of (Node, In_Tree), Indent); 555 Write_Line (";"); 556 Print (First_Comment_After_End (Node, In_Tree), Indent); 557 Write_Empty_Line; 558 end if; 559 560 when N_String_Type_Declaration => 561 pragma Debug (Indicate_Tested (N_String_Type_Declaration)); 562 Print (First_Comment_Before (Node, In_Tree), Indent); 563 Start_Line (Indent); 564 Write_String ("type ", Indent); 565 Output_Name (Name_Of (Node, In_Tree), Indent); 566 Write_Line (" is"); 567 Start_Line (Indent + Increment); 568 Write_String ("(", Indent); 569 570 declare 571 String_Node : Project_Node_Id := 572 First_Literal_String (Node, In_Tree); 573 574 begin 575 while Present (String_Node) loop 576 Output_String 577 (String_Value_Of (String_Node, In_Tree), Indent); 578 String_Node := 579 Next_Literal_String (String_Node, In_Tree); 580 581 if Present (String_Node) then 582 Write_String (", ", Indent); 583 end if; 584 end loop; 585 end; 586 587 Write_String (");", Indent); 588 Write_End_Of_Line_Comment (Node); 589 Print (First_Comment_After (Node, In_Tree), Indent); 590 591 when N_Literal_String => 592 pragma Debug (Indicate_Tested (N_Literal_String)); 593 Output_String (String_Value_Of (Node, In_Tree), Indent); 594 595 if Source_Index_Of (Node, In_Tree) /= 0 then 596 Write_String (" at", Indent); 597 Write_String 598 (Source_Index_Of (Node, In_Tree)'Img, Indent); 599 end if; 600 601 when N_Attribute_Declaration => 602 pragma Debug (Indicate_Tested (N_Attribute_Declaration)); 603 Print (First_Comment_Before (Node, In_Tree), Indent); 604 Start_Line (Indent); 605 Write_String ("for ", Indent); 606 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent); 607 608 if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then 609 Write_String (" (", Indent); 610 Output_String 611 (Associative_Array_Index_Of (Node, In_Tree), Indent); 612 613 if Source_Index_Of (Node, In_Tree) /= 0 then 614 Write_String (" at", Indent); 615 Write_String 616 (Source_Index_Of (Node, In_Tree)'Img, Indent); 617 end if; 618 619 Write_String (")", Indent); 620 end if; 621 622 Write_String (" use ", Indent); 623 624 if Present (Expression_Of (Node, In_Tree)) then 625 Print (Expression_Of (Node, In_Tree), Indent); 626 627 else 628 -- Full associative array declaration 629 630 if Present (Associative_Project_Of (Node, In_Tree)) then 631 Output_Name 632 (Name_Of 633 (Associative_Project_Of (Node, In_Tree), 634 In_Tree), 635 Indent); 636 637 if Present (Associative_Package_Of (Node, In_Tree)) 638 then 639 Write_String (".", Indent); 640 Output_Name 641 (Name_Of 642 (Associative_Package_Of (Node, In_Tree), 643 In_Tree), 644 Indent); 645 end if; 646 647 elsif Present (Associative_Package_Of (Node, In_Tree)) 648 then 649 Output_Name 650 (Name_Of 651 (Associative_Package_Of (Node, In_Tree), 652 In_Tree), 653 Indent); 654 end if; 655 656 Write_String ("'", Indent); 657 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent); 658 end if; 659 660 Write_String (";", Indent); 661 Write_End_Of_Line_Comment (Node); 662 Print (First_Comment_After (Node, In_Tree), Indent); 663 664 when N_Typed_Variable_Declaration => 665 pragma Debug 666 (Indicate_Tested (N_Typed_Variable_Declaration)); 667 Print (First_Comment_Before (Node, In_Tree), Indent); 668 Start_Line (Indent); 669 Output_Name (Name_Of (Node, In_Tree), Indent); 670 Write_String (" : ", Indent); 671 Output_Name 672 (Name_Of (String_Type_Of (Node, In_Tree), In_Tree), 673 Indent); 674 Write_String (" := ", Indent); 675 Print (Expression_Of (Node, In_Tree), Indent); 676 Write_String (";", Indent); 677 Write_End_Of_Line_Comment (Node); 678 Print (First_Comment_After (Node, In_Tree), Indent); 679 680 when N_Variable_Declaration => 681 pragma Debug (Indicate_Tested (N_Variable_Declaration)); 682 Print (First_Comment_Before (Node, In_Tree), Indent); 683 Start_Line (Indent); 684 Output_Name (Name_Of (Node, In_Tree), Indent); 685 Write_String (" := ", Indent); 686 Print (Expression_Of (Node, In_Tree), Indent); 687 Write_String (";", Indent); 688 Write_End_Of_Line_Comment (Node); 689 Print (First_Comment_After (Node, In_Tree), Indent); 690 691 when N_Expression => 692 pragma Debug (Indicate_Tested (N_Expression)); 693 declare 694 Term : Project_Node_Id := First_Term (Node, In_Tree); 695 696 begin 697 while Present (Term) loop 698 Print (Term, Indent); 699 Term := Next_Term (Term, In_Tree); 700 701 if Present (Term) then 702 Write_String (" & ", Indent); 703 end if; 704 end loop; 705 end; 706 707 when N_Term => 708 pragma Debug (Indicate_Tested (N_Term)); 709 Print (Current_Term (Node, In_Tree), Indent); 710 711 when N_Literal_String_List => 712 pragma Debug (Indicate_Tested (N_Literal_String_List)); 713 Write_String ("(", Indent); 714 715 declare 716 Expression : Project_Node_Id := 717 First_Expression_In_List (Node, In_Tree); 718 719 begin 720 while Present (Expression) loop 721 Print (Expression, Indent); 722 Expression := 723 Next_Expression_In_List (Expression, In_Tree); 724 725 if Present (Expression) then 726 Write_String (", ", Indent); 727 end if; 728 end loop; 729 end; 730 731 Write_String (")", Indent); 732 733 when N_Variable_Reference => 734 pragma Debug (Indicate_Tested (N_Variable_Reference)); 735 if Present (Project_Node_Of (Node, In_Tree)) then 736 Output_Name 737 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree), 738 Indent); 739 Write_String (".", Indent); 740 end if; 741 742 if Present (Package_Node_Of (Node, In_Tree)) then 743 Output_Name 744 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree), 745 Indent); 746 Write_String (".", Indent); 747 end if; 748 749 Output_Name (Name_Of (Node, In_Tree), Indent); 750 751 when N_External_Value => 752 pragma Debug (Indicate_Tested (N_External_Value)); 753 Write_String ("external (", Indent); 754 Print (External_Reference_Of (Node, In_Tree), Indent); 755 756 if Present (External_Default_Of (Node, In_Tree)) then 757 Write_String (", ", Indent); 758 Print (External_Default_Of (Node, In_Tree), Indent); 759 end if; 760 761 Write_String (")", Indent); 762 763 when N_Attribute_Reference => 764 pragma Debug (Indicate_Tested (N_Attribute_Reference)); 765 766 if Present (Project_Node_Of (Node, In_Tree)) 767 and then Project_Node_Of (Node, In_Tree) /= Project 768 then 769 Output_Name 770 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree), 771 Indent); 772 773 if Present (Package_Node_Of (Node, In_Tree)) then 774 Write_String (".", Indent); 775 Output_Name 776 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree), 777 Indent); 778 end if; 779 780 elsif Present (Package_Node_Of (Node, In_Tree)) then 781 Output_Name 782 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree), 783 Indent); 784 785 else 786 Write_String ("project", Indent); 787 end if; 788 789 Write_String ("'", Indent); 790 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent); 791 792 declare 793 Index : constant Name_Id := 794 Associative_Array_Index_Of (Node, In_Tree); 795 begin 796 if Index /= No_Name then 797 Write_String (" (", Indent); 798 Output_String (Index, Indent); 799 Write_String (")", Indent); 800 end if; 801 end; 802 803 when N_Case_Construction => 804 pragma Debug (Indicate_Tested (N_Case_Construction)); 805 806 declare 807 Case_Item : Project_Node_Id; 808 Is_Non_Empty : Boolean := False; 809 810 begin 811 Case_Item := First_Case_Item_Of (Node, In_Tree); 812 while Present (Case_Item) loop 813 if Present 814 (First_Declarative_Item_Of (Case_Item, In_Tree)) 815 or else not Eliminate_Empty_Case_Constructions 816 then 817 Is_Non_Empty := True; 818 exit; 819 end if; 820 821 Case_Item := Next_Case_Item (Case_Item, In_Tree); 822 end loop; 823 824 if Is_Non_Empty then 825 Write_Empty_Line; 826 Print (First_Comment_Before (Node, In_Tree), Indent); 827 Start_Line (Indent); 828 Write_String ("case ", Indent); 829 Print 830 (Case_Variable_Reference_Of (Node, In_Tree), Indent); 831 Write_String (" is", Indent); 832 Write_End_Of_Line_Comment (Node); 833 Print 834 (First_Comment_After (Node, In_Tree), 835 Indent + Increment); 836 837 declare 838 Case_Item : Project_Node_Id := 839 First_Case_Item_Of (Node, In_Tree); 840 begin 841 while Present (Case_Item) loop 842 pragma Assert 843 (Kind_Of (Case_Item, In_Tree) = N_Case_Item); 844 Print (Case_Item, Indent + Increment); 845 Case_Item := 846 Next_Case_Item (Case_Item, In_Tree); 847 end loop; 848 end; 849 850 Print (First_Comment_Before_End (Node, In_Tree), 851 Indent + Increment); 852 Start_Line (Indent); 853 Write_Line ("end case;"); 854 Print 855 (First_Comment_After_End (Node, In_Tree), Indent); 856 end if; 857 end; 858 859 when N_Case_Item => 860 pragma Debug (Indicate_Tested (N_Case_Item)); 861 862 if Present (First_Declarative_Item_Of (Node, In_Tree)) 863 or else not Eliminate_Empty_Case_Constructions 864 then 865 Write_Empty_Line; 866 Print (First_Comment_Before (Node, In_Tree), Indent); 867 Start_Line (Indent); 868 Write_String ("when ", Indent); 869 870 if No (First_Choice_Of (Node, In_Tree)) then 871 Write_String ("others", Indent); 872 873 else 874 declare 875 Label : Project_Node_Id := 876 First_Choice_Of (Node, In_Tree); 877 878 begin 879 while Present (Label) loop 880 Print (Label, Indent); 881 Label := Next_Literal_String (Label, In_Tree); 882 883 if Present (Label) then 884 Write_String (" | ", Indent); 885 end if; 886 end loop; 887 end; 888 end if; 889 890 Write_String (" =>", Indent); 891 Write_End_Of_Line_Comment (Node); 892 Print 893 (First_Comment_After (Node, In_Tree), 894 Indent + Increment); 895 896 declare 897 First : constant Project_Node_Id := 898 First_Declarative_Item_Of (Node, In_Tree); 899 begin 900 if No (First) then 901 Write_Empty_Line; 902 else 903 Print (First, Indent + Increment); 904 end if; 905 end; 906 end if; 907 908 when N_Comment_Zones => 909 910 -- Nothing to do, because it will not be processed directly 911 912 null; 913 914 when N_Comment => 915 pragma Debug (Indicate_Tested (N_Comment)); 916 917 if Follows_Empty_Line (Node, In_Tree) then 918 Write_Empty_Line; 919 end if; 920 921 Start_Line (Indent); 922 Write_String ("--", Indent); 923 Write_String 924 (Get_Name_String (String_Value_Of (Node, In_Tree)), 925 Indent, 926 Truncated => True); 927 Write_Line (""); 928 929 if Is_Followed_By_Empty_Line (Node, In_Tree) then 930 Write_Empty_Line; 931 end if; 932 933 Print (Next_Comment (Node, In_Tree), Indent); 934 end case; 935 end if; 936 end Print; 937 938 -- Start of processing for Pretty_Print 939 940 begin 941 if W_Char = null then 942 Write_Char := Output.Write_Char'Access; 943 else 944 Write_Char := W_Char; 945 end if; 946 947 if W_Eol = null then 948 Write_Eol := Output.Write_Eol'Access; 949 else 950 Write_Eol := W_Eol; 951 end if; 952 953 if W_Str = null then 954 Write_Str := Output.Write_Str'Access; 955 else 956 Write_Str := W_Str; 957 end if; 958 959 Print (Project, 0); 960 end Pretty_Print; 961 962 ----------------------- 963 -- Output_Statistics -- 964 ----------------------- 965 966 procedure Output_Statistics is 967 begin 968 Output.Write_Line ("Project_Node_Kinds not tested:"); 969 970 for Kind in Project_Node_Kind loop 971 if Kind /= N_Comment_Zones and then Not_Tested (Kind) then 972 Output.Write_Str (" "); 973 Output.Write_Line (Project_Node_Kind'Image (Kind)); 974 end if; 975 end loop; 976 977 Output.Write_Eol; 978 end Output_Statistics; 979 980 --------- 981 -- wpr -- 982 --------- 983 984 procedure wpr 985 (Project : Prj.Tree.Project_Node_Id; 986 In_Tree : Prj.Tree.Project_Node_Tree_Ref) 987 is 988 begin 989 Pretty_Print (Project, In_Tree, Backward_Compatibility => False); 990 end wpr; 991 992end Prj.PP; 993