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