1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P R J . P P -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-2015, 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 if First_Declarative_Item_Of (Node, In_Tree) = Empty_Node 526 then 527 Write_String (" renames ", Indent); 528 else 529 Write_String (" extends ", Indent); 530 end if; 531 532 Output_Name 533 (Name_Of 534 (Project_Of_Renamed_Package_Of (Node, In_Tree), 535 In_Tree), 536 Indent); 537 Write_String (".", Indent); 538 Output_Name (Name_Of (Node, In_Tree), Indent); 539 end if; 540 541 if Project_Of_Renamed_Package_Of (Node, In_Tree) /= 542 Empty_Node 543 and then 544 First_Declarative_Item_Of (Node, In_Tree) = Empty_Node 545 then 546 Write_String (";", Indent); 547 Write_End_Of_Line_Comment (Node); 548 Print (First_Comment_After_End (Node, In_Tree), Indent); 549 550 else 551 Write_String (" is", Indent); 552 Write_End_Of_Line_Comment (Node); 553 Print (First_Comment_After (Node, In_Tree), 554 Indent + Increment); 555 556 if First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node 557 then 558 Print 559 (First_Declarative_Item_Of (Node, In_Tree), 560 Indent + Increment); 561 end if; 562 563 Print (First_Comment_Before_End (Node, In_Tree), 564 Indent + Increment); 565 Start_Line (Indent); 566 Write_String ("end ", Indent); 567 Output_Name (Name_Of (Node, In_Tree), Indent); 568 Write_Line (";"); 569 Print (First_Comment_After_End (Node, In_Tree), Indent); 570 Write_Empty_Line; 571 end if; 572 573 when N_String_Type_Declaration => 574 pragma Debug (Indicate_Tested (N_String_Type_Declaration)); 575 Print (First_Comment_Before (Node, In_Tree), Indent); 576 Start_Line (Indent); 577 Write_String ("type ", Indent); 578 Output_Name (Name_Of (Node, In_Tree), Indent); 579 Write_Line (" is"); 580 Start_Line (Indent + Increment); 581 Write_String ("(", Indent); 582 583 declare 584 String_Node : Project_Node_Id := 585 First_Literal_String (Node, In_Tree); 586 587 begin 588 while Present (String_Node) loop 589 Output_String 590 (String_Value_Of (String_Node, In_Tree), Indent); 591 String_Node := 592 Next_Literal_String (String_Node, In_Tree); 593 594 if Present (String_Node) then 595 Write_String (", ", Indent); 596 end if; 597 end loop; 598 end; 599 600 Write_String (");", Indent); 601 Write_End_Of_Line_Comment (Node); 602 Print (First_Comment_After (Node, In_Tree), Indent); 603 604 when N_Literal_String => 605 pragma Debug (Indicate_Tested (N_Literal_String)); 606 Output_String (String_Value_Of (Node, In_Tree), Indent); 607 608 if Source_Index_Of (Node, In_Tree) /= 0 then 609 Write_String (" at", Indent); 610 Write_String 611 (Source_Index_Of (Node, In_Tree)'Img, Indent); 612 end if; 613 614 when N_Attribute_Declaration => 615 pragma Debug (Indicate_Tested (N_Attribute_Declaration)); 616 Print (First_Comment_Before (Node, In_Tree), Indent); 617 Start_Line (Indent); 618 Write_String ("for ", Indent); 619 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent); 620 621 if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then 622 Write_String (" (", Indent); 623 Output_String 624 (Associative_Array_Index_Of (Node, In_Tree), Indent); 625 626 if Source_Index_Of (Node, In_Tree) /= 0 then 627 Write_String (" at", Indent); 628 Write_String 629 (Source_Index_Of (Node, In_Tree)'Img, Indent); 630 end if; 631 632 Write_String (")", Indent); 633 end if; 634 635 Write_String (" use ", Indent); 636 637 if Present (Expression_Of (Node, In_Tree)) then 638 Print (Expression_Of (Node, In_Tree), Indent); 639 640 else 641 -- Full associative array declaration 642 643 if Present (Associative_Project_Of (Node, In_Tree)) then 644 Output_Name 645 (Name_Of 646 (Associative_Project_Of (Node, In_Tree), 647 In_Tree), 648 Indent); 649 650 if Present (Associative_Package_Of (Node, In_Tree)) 651 then 652 Write_String (".", Indent); 653 Output_Name 654 (Name_Of 655 (Associative_Package_Of (Node, In_Tree), 656 In_Tree), 657 Indent); 658 end if; 659 660 elsif Present (Associative_Package_Of (Node, In_Tree)) 661 then 662 Output_Name 663 (Name_Of 664 (Associative_Package_Of (Node, In_Tree), 665 In_Tree), 666 Indent); 667 end if; 668 669 Write_String ("'", Indent); 670 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent); 671 end if; 672 673 Write_String (";", Indent); 674 Write_End_Of_Line_Comment (Node); 675 Print (First_Comment_After (Node, In_Tree), Indent); 676 677 when N_Typed_Variable_Declaration => 678 pragma Debug 679 (Indicate_Tested (N_Typed_Variable_Declaration)); 680 Print (First_Comment_Before (Node, In_Tree), Indent); 681 Start_Line (Indent); 682 Output_Name (Name_Of (Node, In_Tree), Indent); 683 Write_String (" : ", Indent); 684 Output_Name 685 (Name_Of (String_Type_Of (Node, In_Tree), In_Tree), 686 Indent); 687 Write_String (" := ", Indent); 688 Print (Expression_Of (Node, In_Tree), Indent); 689 Write_String (";", Indent); 690 Write_End_Of_Line_Comment (Node); 691 Print (First_Comment_After (Node, In_Tree), Indent); 692 693 when N_Variable_Declaration => 694 pragma Debug (Indicate_Tested (N_Variable_Declaration)); 695 Print (First_Comment_Before (Node, In_Tree), Indent); 696 Start_Line (Indent); 697 Output_Name (Name_Of (Node, In_Tree), Indent); 698 Write_String (" := ", Indent); 699 Print (Expression_Of (Node, In_Tree), Indent); 700 Write_String (";", Indent); 701 Write_End_Of_Line_Comment (Node); 702 Print (First_Comment_After (Node, In_Tree), Indent); 703 704 when N_Expression => 705 pragma Debug (Indicate_Tested (N_Expression)); 706 declare 707 Term : Project_Node_Id := First_Term (Node, In_Tree); 708 709 begin 710 while Present (Term) loop 711 Print (Term, Indent); 712 Term := Next_Term (Term, In_Tree); 713 714 if Present (Term) then 715 Write_String (" & ", Indent); 716 end if; 717 end loop; 718 end; 719 720 when N_Term => 721 pragma Debug (Indicate_Tested (N_Term)); 722 Print (Current_Term (Node, In_Tree), Indent); 723 724 when N_Literal_String_List => 725 pragma Debug (Indicate_Tested (N_Literal_String_List)); 726 Write_String ("(", Indent); 727 728 declare 729 Expression : Project_Node_Id := 730 First_Expression_In_List (Node, In_Tree); 731 732 begin 733 while Present (Expression) loop 734 Print (Expression, Indent); 735 Expression := 736 Next_Expression_In_List (Expression, In_Tree); 737 738 if Present (Expression) then 739 Write_String (", ", Indent); 740 end if; 741 end loop; 742 end; 743 744 Write_String (")", Indent); 745 746 when N_Variable_Reference => 747 pragma Debug (Indicate_Tested (N_Variable_Reference)); 748 if Present (Project_Node_Of (Node, In_Tree)) then 749 Output_Name 750 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree), 751 Indent); 752 Write_String (".", Indent); 753 end if; 754 755 if Present (Package_Node_Of (Node, In_Tree)) then 756 Output_Name 757 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree), 758 Indent); 759 Write_String (".", Indent); 760 end if; 761 762 Output_Name (Name_Of (Node, In_Tree), Indent); 763 764 when N_External_Value => 765 pragma Debug (Indicate_Tested (N_External_Value)); 766 Write_String ("external (", Indent); 767 Print (External_Reference_Of (Node, In_Tree), Indent); 768 769 if Present (External_Default_Of (Node, In_Tree)) then 770 Write_String (", ", Indent); 771 Print (External_Default_Of (Node, In_Tree), Indent); 772 end if; 773 774 Write_String (")", Indent); 775 776 when N_Attribute_Reference => 777 pragma Debug (Indicate_Tested (N_Attribute_Reference)); 778 779 if Present (Project_Node_Of (Node, In_Tree)) 780 and then Project_Node_Of (Node, In_Tree) /= Project 781 then 782 Output_Name 783 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree), 784 Indent); 785 786 if Present (Package_Node_Of (Node, In_Tree)) then 787 Write_String (".", Indent); 788 Output_Name 789 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree), 790 Indent); 791 end if; 792 793 elsif Present (Package_Node_Of (Node, In_Tree)) then 794 Output_Name 795 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree), 796 Indent); 797 798 else 799 Write_String ("project", Indent); 800 end if; 801 802 Write_String ("'", Indent); 803 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent); 804 805 declare 806 Index : constant Name_Id := 807 Associative_Array_Index_Of (Node, In_Tree); 808 begin 809 if Index /= No_Name then 810 Write_String (" (", Indent); 811 Output_String (Index, Indent); 812 Write_String (")", Indent); 813 end if; 814 end; 815 816 when N_Case_Construction => 817 pragma Debug (Indicate_Tested (N_Case_Construction)); 818 819 declare 820 Case_Item : Project_Node_Id; 821 Is_Non_Empty : Boolean := False; 822 823 begin 824 Case_Item := First_Case_Item_Of (Node, In_Tree); 825 while Present (Case_Item) loop 826 if Present 827 (First_Declarative_Item_Of (Case_Item, In_Tree)) 828 or else not Eliminate_Empty_Case_Constructions 829 then 830 Is_Non_Empty := True; 831 exit; 832 end if; 833 834 Case_Item := Next_Case_Item (Case_Item, In_Tree); 835 end loop; 836 837 if Is_Non_Empty then 838 Write_Empty_Line; 839 Print (First_Comment_Before (Node, In_Tree), Indent); 840 Start_Line (Indent); 841 Write_String ("case ", Indent); 842 Print 843 (Case_Variable_Reference_Of (Node, In_Tree), Indent); 844 Write_String (" is", Indent); 845 Write_End_Of_Line_Comment (Node); 846 Print 847 (First_Comment_After (Node, In_Tree), 848 Indent + Increment); 849 850 declare 851 Case_Item : Project_Node_Id := 852 First_Case_Item_Of (Node, In_Tree); 853 begin 854 while Present (Case_Item) loop 855 pragma Assert 856 (Kind_Of (Case_Item, In_Tree) = N_Case_Item); 857 Print (Case_Item, Indent + Increment); 858 Case_Item := 859 Next_Case_Item (Case_Item, In_Tree); 860 end loop; 861 end; 862 863 Print (First_Comment_Before_End (Node, In_Tree), 864 Indent + Increment); 865 Start_Line (Indent); 866 Write_Line ("end case;"); 867 Print 868 (First_Comment_After_End (Node, In_Tree), Indent); 869 end if; 870 end; 871 872 when N_Case_Item => 873 pragma Debug (Indicate_Tested (N_Case_Item)); 874 875 if Present (First_Declarative_Item_Of (Node, In_Tree)) 876 or else not Eliminate_Empty_Case_Constructions 877 then 878 Write_Empty_Line; 879 Print (First_Comment_Before (Node, In_Tree), Indent); 880 Start_Line (Indent); 881 Write_String ("when ", Indent); 882 883 if No (First_Choice_Of (Node, In_Tree)) then 884 Write_String ("others", Indent); 885 886 else 887 declare 888 Label : Project_Node_Id := 889 First_Choice_Of (Node, In_Tree); 890 891 begin 892 while Present (Label) loop 893 Print (Label, Indent); 894 Label := Next_Literal_String (Label, In_Tree); 895 896 if Present (Label) then 897 Write_String (" | ", Indent); 898 end if; 899 end loop; 900 end; 901 end if; 902 903 Write_String (" =>", Indent); 904 Write_End_Of_Line_Comment (Node); 905 Print 906 (First_Comment_After (Node, In_Tree), 907 Indent + Increment); 908 909 declare 910 First : constant Project_Node_Id := 911 First_Declarative_Item_Of (Node, In_Tree); 912 begin 913 if No (First) then 914 Write_Empty_Line; 915 else 916 Print (First, Indent + Increment); 917 end if; 918 end; 919 end if; 920 921 when N_Comment_Zones => 922 923 -- Nothing to do, because it will not be processed directly 924 925 null; 926 927 when N_Comment => 928 pragma Debug (Indicate_Tested (N_Comment)); 929 930 if Follows_Empty_Line (Node, In_Tree) then 931 Write_Empty_Line; 932 end if; 933 934 Start_Line (Indent); 935 Write_String ("--", Indent); 936 Write_String 937 (Get_Name_String (String_Value_Of (Node, In_Tree)), 938 Indent, 939 Truncated => True); 940 Write_Line (""); 941 942 if Is_Followed_By_Empty_Line (Node, In_Tree) then 943 Write_Empty_Line; 944 end if; 945 946 Print (Next_Comment (Node, In_Tree), Indent); 947 end case; 948 end if; 949 end Print; 950 951 -- Start of processing for Pretty_Print 952 953 begin 954 if W_Char = null then 955 Write_Char := Output.Write_Char'Access; 956 else 957 Write_Char := W_Char; 958 end if; 959 960 if W_Eol = null then 961 Write_Eol := Output.Write_Eol'Access; 962 else 963 Write_Eol := W_Eol; 964 end if; 965 966 if W_Str = null then 967 Write_Str := Output.Write_Str'Access; 968 else 969 Write_Str := W_Str; 970 end if; 971 972 Print (Project, 0); 973 end Pretty_Print; 974 975 ----------------------- 976 -- Output_Statistics -- 977 ----------------------- 978 979 procedure Output_Statistics is 980 begin 981 Output.Write_Line ("Project_Node_Kinds not tested:"); 982 983 for Kind in Project_Node_Kind loop 984 if Kind /= N_Comment_Zones and then Not_Tested (Kind) then 985 Output.Write_Str (" "); 986 Output.Write_Line (Project_Node_Kind'Image (Kind)); 987 end if; 988 end loop; 989 990 Output.Write_Eol; 991 end Output_Statistics; 992 993 --------- 994 -- wpr -- 995 --------- 996 997 procedure wpr 998 (Project : Prj.Tree.Project_Node_Id; 999 In_Tree : Prj.Tree.Project_Node_Tree_Ref) 1000 is 1001 begin 1002 Pretty_Print (Project, In_Tree, Backward_Compatibility => False); 1003 end wpr; 1004 1005end Prj.PP; 1006