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