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