gcc/ada/prj-pp.adb

   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
  26 with Ada.Characters.Handling; use Ada.Characters.Handling;
  27
  28 with Output;   use Output;
  29 with Snames;
  30
  31 package 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
 992 end Prj.PP;