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