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