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