1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P R J . P P -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-2013, 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 284 then 285 Write_Eol.all; 286 Column := 0; 287 Last_Line_Is_Empty := True; 288 end if; 289 end Write_Empty_Line; 290 291 ------------------------------- 292 -- Write_End_Of_Line_Comment -- 293 ------------------------------- 294 295 procedure Write_End_Of_Line_Comment (Node : Project_Node_Id) is 296 Value : constant Name_Id := End_Of_Line_Comment (Node, In_Tree); 297 298 begin 299 if Value /= No_Name then 300 Write_String (" --", 0); 301 Write_String (Get_Name_String (Value), 0, Truncated => True); 302 end if; 303 304 Write_Line (""); 305 end Write_End_Of_Line_Comment; 306 307 ---------------- 308 -- Write_Line -- 309 ---------------- 310 311 procedure Write_Line (S : String) is 312 begin 313 Write_String (S, 0); 314 Last_Line_Is_Empty := False; 315 Write_Eol.all; 316 Column := 0; 317 end Write_Line; 318 319 ------------------ 320 -- Write_String -- 321 ------------------ 322 323 procedure Write_String 324 (S : String; 325 Indent : Natural; 326 Truncated : Boolean := False) is 327 Length : Natural := S'Length; 328 begin 329 if Column = 0 and then Indent /= 0 then 330 Start_Line (Indent + Increment); 331 end if; 332 333 -- If the string would not fit on the line, 334 -- start a new line. 335 336 if Column + Length > Max_Line_Length then 337 if Truncated then 338 Length := Max_Line_Length - Column; 339 340 else 341 Write_Eol.all; 342 Column := 0; 343 344 if Indent /= 0 then 345 Start_Line (Indent + Increment); 346 end if; 347 end if; 348 end if; 349 350 Write_Str (S (S'First .. S'First + Length - 1)); 351 Column := Column + Length; 352 end Write_String; 353 354 ----------- 355 -- Print -- 356 ----------- 357 358 procedure Print (Node : Project_Node_Id; Indent : Natural) is 359 begin 360 if Present (Node) then 361 362 case Kind_Of (Node, In_Tree) is 363 364 when N_Project => 365 pragma Debug (Indicate_Tested (N_Project)); 366 if Present (First_With_Clause_Of (Node, In_Tree)) then 367 368 -- with clause(s) 369 370 First_With_In_List := True; 371 Print (First_With_Clause_Of (Node, In_Tree), Indent); 372 Write_Empty_Line (Always => True); 373 end if; 374 375 Print (First_Comment_Before (Node, In_Tree), Indent); 376 Start_Line (Indent); 377 378 case Project_Qualifier_Of (Node, In_Tree) is 379 when Unspecified | Standard => 380 null; 381 when Aggregate => 382 Write_String ("aggregate ", Indent); 383 when Aggregate_Library => 384 Write_String ("aggregate library ", Indent); 385 when Library => 386 Write_String ("library ", Indent); 387 when Configuration => 388 Write_String ("configuration ", Indent); 389 when Dry => 390 Write_String ("abstract ", Indent); 391 end case; 392 393 Write_String ("project ", Indent); 394 395 if Id /= Prj.No_Project then 396 Output_Name (Id.Display_Name, Indent); 397 else 398 Output_Name (Name_Of (Node, In_Tree), Indent); 399 end if; 400 401 -- Check if this project extends another project 402 403 if Extended_Project_Path_Of (Node, In_Tree) /= No_Path then 404 Write_String (" extends ", Indent); 405 406 if Is_Extending_All (Node, In_Tree) then 407 Write_String ("all ", Indent); 408 end if; 409 410 Output_String 411 (Extended_Project_Path_Of (Node, In_Tree), 412 Indent); 413 end if; 414 415 Write_String (" is", Indent); 416 Write_End_Of_Line_Comment (Node); 417 Print 418 (First_Comment_After (Node, In_Tree), Indent + Increment); 419 Write_Empty_Line (Always => True); 420 421 -- Output all of the declarations in the project 422 423 Print (Project_Declaration_Of (Node, In_Tree), Indent); 424 Print 425 (First_Comment_Before_End (Node, In_Tree), 426 Indent + Increment); 427 Start_Line (Indent); 428 Write_String ("end ", Indent); 429 430 if Id /= Prj.No_Project then 431 Output_Name (Id.Display_Name, Indent); 432 else 433 Output_Name (Name_Of (Node, In_Tree), Indent); 434 end if; 435 436 Write_Line (";"); 437 Print (First_Comment_After_End (Node, In_Tree), Indent); 438 439 when N_With_Clause => 440 pragma Debug (Indicate_Tested (N_With_Clause)); 441 442 -- The with clause will sometimes contain an invalid name 443 -- when we are importing a virtual project from an 444 -- extending all project. Do not output anything in this 445 -- case 446 447 if Name_Of (Node, In_Tree) /= No_Name 448 and then String_Value_Of (Node, In_Tree) /= No_Name 449 then 450 if First_With_In_List then 451 Print (First_Comment_Before (Node, In_Tree), Indent); 452 Start_Line (Indent); 453 454 if Non_Limited_Project_Node_Of (Node, In_Tree) = 455 Empty_Node 456 then 457 Write_String ("limited ", Indent); 458 end if; 459 460 Write_String ("with ", Indent); 461 end if; 462 463 Output_String (String_Value_Of (Node, In_Tree), Indent); 464 465 if Is_Not_Last_In_List (Node, In_Tree) then 466 Write_String (", ", Indent); 467 First_With_In_List := False; 468 469 else 470 Write_String (";", Indent); 471 Write_End_Of_Line_Comment (Node); 472 Print (First_Comment_After (Node, In_Tree), Indent); 473 First_With_In_List := True; 474 end if; 475 end if; 476 477 Print (Next_With_Clause_Of (Node, In_Tree), Indent); 478 479 when N_Project_Declaration => 480 pragma Debug (Indicate_Tested (N_Project_Declaration)); 481 482 if 483 Present (First_Declarative_Item_Of (Node, In_Tree)) 484 then 485 Print 486 (First_Declarative_Item_Of (Node, In_Tree), 487 Indent + Increment); 488 Write_Empty_Line (Always => True); 489 end if; 490 491 when N_Declarative_Item => 492 pragma Debug (Indicate_Tested (N_Declarative_Item)); 493 Print (Current_Item_Node (Node, In_Tree), Indent); 494 Print (Next_Declarative_Item (Node, In_Tree), Indent); 495 496 when N_Package_Declaration => 497 pragma Debug (Indicate_Tested (N_Package_Declaration)); 498 Write_Empty_Line (Always => True); 499 Print (First_Comment_Before (Node, In_Tree), Indent); 500 Start_Line (Indent); 501 Write_String ("package ", Indent); 502 Output_Name (Name_Of (Node, In_Tree), Indent); 503 504 if Project_Of_Renamed_Package_Of (Node, In_Tree) /= 505 Empty_Node 506 then 507 Write_String (" renames ", Indent); 508 Output_Name 509 (Name_Of 510 (Project_Of_Renamed_Package_Of (Node, In_Tree), 511 In_Tree), 512 Indent); 513 Write_String (".", Indent); 514 Output_Name (Name_Of (Node, In_Tree), Indent); 515 Write_String (";", Indent); 516 Write_End_Of_Line_Comment (Node); 517 Print (First_Comment_After_End (Node, In_Tree), Indent); 518 519 else 520 Write_String (" is", Indent); 521 Write_End_Of_Line_Comment (Node); 522 Print (First_Comment_After (Node, In_Tree), 523 Indent + Increment); 524 525 if First_Declarative_Item_Of (Node, In_Tree) /= 526 Empty_Node 527 then 528 Print 529 (First_Declarative_Item_Of (Node, In_Tree), 530 Indent + Increment); 531 end if; 532 533 Print (First_Comment_Before_End (Node, In_Tree), 534 Indent + Increment); 535 Start_Line (Indent); 536 Write_String ("end ", Indent); 537 Output_Name (Name_Of (Node, In_Tree), Indent); 538 Write_Line (";"); 539 Print (First_Comment_After_End (Node, In_Tree), Indent); 540 Write_Empty_Line; 541 end if; 542 543 when N_String_Type_Declaration => 544 pragma Debug (Indicate_Tested (N_String_Type_Declaration)); 545 Print (First_Comment_Before (Node, In_Tree), Indent); 546 Start_Line (Indent); 547 Write_String ("type ", Indent); 548 Output_Name (Name_Of (Node, In_Tree), Indent); 549 Write_Line (" is"); 550 Start_Line (Indent + Increment); 551 Write_String ("(", Indent); 552 553 declare 554 String_Node : Project_Node_Id := 555 First_Literal_String (Node, In_Tree); 556 557 begin 558 while Present (String_Node) loop 559 Output_String 560 (String_Value_Of (String_Node, In_Tree), 561 Indent); 562 String_Node := 563 Next_Literal_String (String_Node, In_Tree); 564 565 if Present (String_Node) then 566 Write_String (", ", Indent); 567 end if; 568 end loop; 569 end; 570 571 Write_String (");", Indent); 572 Write_End_Of_Line_Comment (Node); 573 Print (First_Comment_After (Node, In_Tree), Indent); 574 575 when N_Literal_String => 576 pragma Debug (Indicate_Tested (N_Literal_String)); 577 Output_String (String_Value_Of (Node, In_Tree), Indent); 578 579 if Source_Index_Of (Node, In_Tree) /= 0 then 580 Write_String (" at", Indent); 581 Write_String 582 (Source_Index_Of (Node, In_Tree)'Img, 583 Indent); 584 end if; 585 586 when N_Attribute_Declaration => 587 pragma Debug (Indicate_Tested (N_Attribute_Declaration)); 588 Print (First_Comment_Before (Node, In_Tree), Indent); 589 Start_Line (Indent); 590 Write_String ("for ", Indent); 591 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent); 592 593 if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then 594 Write_String (" (", Indent); 595 Output_String 596 (Associative_Array_Index_Of (Node, In_Tree), 597 Indent); 598 599 if Source_Index_Of (Node, In_Tree) /= 0 then 600 Write_String (" at", Indent); 601 Write_String 602 (Source_Index_Of (Node, In_Tree)'Img, 603 Indent); 604 end if; 605 606 Write_String (")", Indent); 607 end if; 608 609 Write_String (" use ", Indent); 610 611 if Present (Expression_Of (Node, In_Tree)) then 612 Print (Expression_Of (Node, In_Tree), Indent); 613 614 else 615 -- Full associative array declaration 616 617 if 618 Present (Associative_Project_Of (Node, In_Tree)) 619 then 620 Output_Name 621 (Name_Of 622 (Associative_Project_Of (Node, In_Tree), 623 In_Tree), 624 Indent); 625 626 if 627 Present (Associative_Package_Of (Node, In_Tree)) 628 then 629 Write_String (".", Indent); 630 Output_Name 631 (Name_Of 632 (Associative_Package_Of (Node, In_Tree), 633 In_Tree), 634 Indent); 635 end if; 636 637 elsif 638 Present (Associative_Package_Of (Node, In_Tree)) 639 then 640 Output_Name 641 (Name_Of 642 (Associative_Package_Of (Node, In_Tree), 643 In_Tree), 644 Indent); 645 end if; 646 647 Write_String ("'", Indent); 648 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent); 649 end if; 650 651 Write_String (";", Indent); 652 Write_End_Of_Line_Comment (Node); 653 Print (First_Comment_After (Node, In_Tree), Indent); 654 655 when N_Typed_Variable_Declaration => 656 pragma Debug 657 (Indicate_Tested (N_Typed_Variable_Declaration)); 658 Print (First_Comment_Before (Node, In_Tree), Indent); 659 Start_Line (Indent); 660 Output_Name (Name_Of (Node, In_Tree), Indent); 661 Write_String (" : ", Indent); 662 Output_Name 663 (Name_Of (String_Type_Of (Node, In_Tree), In_Tree), 664 Indent); 665 Write_String (" := ", Indent); 666 Print (Expression_Of (Node, In_Tree), Indent); 667 Write_String (";", Indent); 668 Write_End_Of_Line_Comment (Node); 669 Print (First_Comment_After (Node, In_Tree), Indent); 670 671 when N_Variable_Declaration => 672 pragma Debug (Indicate_Tested (N_Variable_Declaration)); 673 Print (First_Comment_Before (Node, In_Tree), Indent); 674 Start_Line (Indent); 675 Output_Name (Name_Of (Node, In_Tree), Indent); 676 Write_String (" := ", Indent); 677 Print (Expression_Of (Node, In_Tree), Indent); 678 Write_String (";", Indent); 679 Write_End_Of_Line_Comment (Node); 680 Print (First_Comment_After (Node, In_Tree), Indent); 681 682 when N_Expression => 683 pragma Debug (Indicate_Tested (N_Expression)); 684 declare 685 Term : Project_Node_Id := First_Term (Node, In_Tree); 686 687 begin 688 while Present (Term) loop 689 Print (Term, Indent); 690 Term := Next_Term (Term, In_Tree); 691 692 if Present (Term) then 693 Write_String (" & ", Indent); 694 end if; 695 end loop; 696 end; 697 698 when N_Term => 699 pragma Debug (Indicate_Tested (N_Term)); 700 Print (Current_Term (Node, In_Tree), Indent); 701 702 when N_Literal_String_List => 703 pragma Debug (Indicate_Tested (N_Literal_String_List)); 704 Write_String ("(", Indent); 705 706 declare 707 Expression : Project_Node_Id := 708 First_Expression_In_List (Node, In_Tree); 709 710 begin 711 while Present (Expression) loop 712 Print (Expression, Indent); 713 Expression := 714 Next_Expression_In_List (Expression, In_Tree); 715 716 if Present (Expression) then 717 Write_String (", ", Indent); 718 end if; 719 end loop; 720 end; 721 722 Write_String (")", Indent); 723 724 when N_Variable_Reference => 725 pragma Debug (Indicate_Tested (N_Variable_Reference)); 726 if Present (Project_Node_Of (Node, In_Tree)) then 727 Output_Name 728 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree), 729 Indent); 730 Write_String (".", Indent); 731 end if; 732 733 if Present (Package_Node_Of (Node, In_Tree)) then 734 Output_Name 735 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree), 736 Indent); 737 Write_String (".", Indent); 738 end if; 739 740 Output_Name (Name_Of (Node, In_Tree), Indent); 741 742 when N_External_Value => 743 pragma Debug (Indicate_Tested (N_External_Value)); 744 Write_String ("external (", Indent); 745 Print (External_Reference_Of (Node, In_Tree), Indent); 746 747 if Present (External_Default_Of (Node, In_Tree)) then 748 Write_String (", ", Indent); 749 Print (External_Default_Of (Node, In_Tree), Indent); 750 end if; 751 752 Write_String (")", Indent); 753 754 when N_Attribute_Reference => 755 pragma Debug (Indicate_Tested (N_Attribute_Reference)); 756 757 if Present (Project_Node_Of (Node, In_Tree)) 758 and then Project_Node_Of (Node, In_Tree) /= Project 759 then 760 Output_Name 761 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree), 762 Indent); 763 764 if Present (Package_Node_Of (Node, In_Tree)) then 765 Write_String (".", Indent); 766 Output_Name 767 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree), 768 Indent); 769 end if; 770 771 elsif Present (Package_Node_Of (Node, In_Tree)) then 772 Output_Name 773 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree), 774 Indent); 775 776 else 777 Write_String ("project", Indent); 778 end if; 779 780 Write_String ("'", Indent); 781 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent); 782 783 declare 784 Index : constant Name_Id := 785 Associative_Array_Index_Of (Node, In_Tree); 786 787 begin 788 if Index /= No_Name then 789 Write_String (" (", Indent); 790 Output_String (Index, Indent); 791 Write_String (")", Indent); 792 end if; 793 end; 794 795 when N_Case_Construction => 796 pragma Debug (Indicate_Tested (N_Case_Construction)); 797 798 declare 799 Case_Item : Project_Node_Id; 800 Is_Non_Empty : Boolean := False; 801 802 begin 803 Case_Item := First_Case_Item_Of (Node, In_Tree); 804 while Present (Case_Item) loop 805 if Present 806 (First_Declarative_Item_Of (Case_Item, In_Tree)) 807 or else not Eliminate_Empty_Case_Constructions 808 then 809 Is_Non_Empty := True; 810 exit; 811 end if; 812 813 Case_Item := Next_Case_Item (Case_Item, In_Tree); 814 end loop; 815 816 if Is_Non_Empty then 817 Write_Empty_Line; 818 Print (First_Comment_Before (Node, In_Tree), Indent); 819 Start_Line (Indent); 820 Write_String ("case ", Indent); 821 Print 822 (Case_Variable_Reference_Of (Node, In_Tree), 823 Indent); 824 Write_String (" is", Indent); 825 Write_End_Of_Line_Comment (Node); 826 Print 827 (First_Comment_After (Node, In_Tree), 828 Indent + Increment); 829 830 declare 831 Case_Item : Project_Node_Id := 832 First_Case_Item_Of (Node, In_Tree); 833 begin 834 while Present (Case_Item) loop 835 pragma Assert 836 (Kind_Of (Case_Item, In_Tree) = N_Case_Item); 837 Print (Case_Item, Indent + Increment); 838 Case_Item := 839 Next_Case_Item (Case_Item, In_Tree); 840 end loop; 841 end; 842 843 Print (First_Comment_Before_End (Node, In_Tree), 844 Indent + Increment); 845 Start_Line (Indent); 846 Write_Line ("end case;"); 847 Print 848 (First_Comment_After_End (Node, In_Tree), Indent); 849 end if; 850 end; 851 852 when N_Case_Item => 853 pragma Debug (Indicate_Tested (N_Case_Item)); 854 855 if Present (First_Declarative_Item_Of (Node, In_Tree)) 856 or else not Eliminate_Empty_Case_Constructions 857 then 858 Write_Empty_Line; 859 Print (First_Comment_Before (Node, In_Tree), Indent); 860 Start_Line (Indent); 861 Write_String ("when ", Indent); 862 863 if No (First_Choice_Of (Node, In_Tree)) then 864 Write_String ("others", Indent); 865 866 else 867 declare 868 Label : Project_Node_Id := 869 First_Choice_Of (Node, In_Tree); 870 begin 871 while Present (Label) loop 872 Print (Label, Indent); 873 Label := Next_Literal_String (Label, In_Tree); 874 875 if Present (Label) then 876 Write_String (" | ", Indent); 877 end if; 878 end loop; 879 end; 880 end if; 881 882 Write_String (" =>", Indent); 883 Write_End_Of_Line_Comment (Node); 884 Print 885 (First_Comment_After (Node, In_Tree), 886 Indent + Increment); 887 888 declare 889 First : constant Project_Node_Id := 890 First_Declarative_Item_Of (Node, In_Tree); 891 begin 892 if No (First) then 893 Write_Empty_Line; 894 else 895 Print (First, Indent + Increment); 896 end if; 897 end; 898 end if; 899 900 when N_Comment_Zones => 901 902 -- Nothing to do, because it will not be processed directly 903 904 null; 905 906 when N_Comment => 907 pragma Debug (Indicate_Tested (N_Comment)); 908 909 if Follows_Empty_Line (Node, In_Tree) then 910 Write_Empty_Line; 911 end if; 912 913 Start_Line (Indent); 914 Write_String ("--", Indent); 915 Write_String 916 (Get_Name_String (String_Value_Of (Node, In_Tree)), 917 Indent, 918 Truncated => True); 919 Write_Line (""); 920 921 if Is_Followed_By_Empty_Line (Node, In_Tree) then 922 Write_Empty_Line; 923 end if; 924 925 Print (Next_Comment (Node, In_Tree), Indent); 926 end case; 927 end if; 928 end Print; 929 930 -- Start of processing for Pretty_Print 931 932 begin 933 if W_Char = null then 934 Write_Char := Output.Write_Char'Access; 935 else 936 Write_Char := W_Char; 937 end if; 938 939 if W_Eol = null then 940 Write_Eol := Output.Write_Eol'Access; 941 else 942 Write_Eol := W_Eol; 943 end if; 944 945 if W_Str = null then 946 Write_Str := Output.Write_Str'Access; 947 else 948 Write_Str := W_Str; 949 end if; 950 951 Print (Project, 0); 952 end Pretty_Print; 953 954 ----------------------- 955 -- Output_Statistics -- 956 ----------------------- 957 958 procedure Output_Statistics is 959 begin 960 Output.Write_Line ("Project_Node_Kinds not tested:"); 961 962 for Kind in Project_Node_Kind loop 963 if Kind /= N_Comment_Zones and then Not_Tested (Kind) then 964 Output.Write_Str (" "); 965 Output.Write_Line (Project_Node_Kind'Image (Kind)); 966 end if; 967 end loop; 968 969 Output.Write_Eol; 970 end Output_Statistics; 971 972 --------- 973 -- wpr -- 974 --------- 975 976 procedure wpr 977 (Project : Prj.Tree.Project_Node_Id; 978 In_Tree : Prj.Tree.Project_Node_Tree_Ref) is 979 begin 980 Pretty_Print (Project, In_Tree, Backward_Compatibility => False); 981 end wpr; 982 983end Prj.PP; 984