Subversion Repositories openrisc

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                               P R J . P P                                --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2001-2011, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
with Ada.Characters.Handling; use Ada.Characters.Handling;
 
with Output;   use Output;
with Snames;
 
package body Prj.PP is
 
   use Prj.Tree;
 
   Not_Tested : array (Project_Node_Kind) of Boolean := (others => True);
 
   procedure Indicate_Tested (Kind : Project_Node_Kind);
   --  Set the corresponding component of array Not_Tested to False.
   --  Only called by pragmas Debug.
 
   ---------------------
   -- Indicate_Tested --
   ---------------------
 
   procedure Indicate_Tested (Kind : Project_Node_Kind) is
   begin
      Not_Tested (Kind) := False;
   end Indicate_Tested;
 
   ------------------
   -- Pretty_Print --
   ------------------
 
   procedure Pretty_Print
     (Project                            : Prj.Tree.Project_Node_Id;
      In_Tree                            : Prj.Tree.Project_Node_Tree_Ref;
      Increment                          : Positive       := 3;
      Eliminate_Empty_Case_Constructions : Boolean        := False;
      Minimize_Empty_Lines               : Boolean        := False;
      W_Char                             : Write_Char_Ap  := null;
      W_Eol                              : Write_Eol_Ap   := null;
      W_Str                              : Write_Str_Ap   := null;
      Backward_Compatibility             : Boolean;
      Id                                 : Prj.Project_Id := Prj.No_Project;
      Max_Line_Length                    : Max_Length_Of_Line :=
                                             Max_Length_Of_Line'Last)
   is
      procedure Print (Node : Project_Node_Id; Indent : Natural);
      --  A recursive procedure that traverses a project file tree and outputs
      --  its source. Current_Prj is the project that we are printing. This
      --  is used when printing attributes, since in nested packages they
      --  need to use a fully qualified name.
 
      procedure Output_Attribute_Name (Name : Name_Id; Indent : Natural);
      --  Outputs an attribute name, taking into account the value of
      --  Backward_Compatibility.
 
      procedure Output_Name
        (Name       : Name_Id;
         Indent     : Natural;
         Capitalize : Boolean := True);
      --  Outputs a name
 
      procedure Start_Line (Indent : Natural);
      --  Outputs the indentation at the beginning of the line
 
      procedure Output_String (S : Name_Id; Indent : Natural);
      procedure Output_String (S : Path_Name_Type; Indent : Natural);
      --  Outputs a string using the default output procedures
 
      procedure Write_Empty_Line (Always : Boolean := False);
      --  Outputs an empty line, only if the previous line was not empty
      --  already and either Always is True or Minimize_Empty_Lines is
      --  False.
 
      procedure Write_Line (S : String);
      --  Outputs S followed by a new line
 
      procedure Write_String
        (S         : String;
         Indent    : Natural;
         Truncated : Boolean := False);
      --  Outputs S using Write_Str, starting a new line if line would
      --  become too long, when Truncated = False.
      --  When Truncated = True, only the part of the string that can fit on
      --  the line is output.
 
      procedure Write_End_Of_Line_Comment (Node : Project_Node_Id);
 
      Write_Char : Write_Char_Ap := Output.Write_Char'Access;
      Write_Eol  : Write_Eol_Ap := Output.Write_Eol'Access;
      Write_Str  : Write_Str_Ap := Output.Write_Str'Access;
      --  These three access to procedure values are used for the output
 
      Last_Line_Is_Empty : Boolean := False;
      --  Used to avoid two consecutive empty lines
 
      Column : Natural := 0;
      --  Column number of the last character in the line. Used to avoid
      --  outputting lines longer than Max_Line_Length.
 
      First_With_In_List : Boolean := True;
      --  Indicate that the next with clause is first in a list such as
      --    with "A", "B";
      --  First_With_In_List will be True for "A", but not for "B".
 
      ---------------------------
      -- Output_Attribute_Name --
      ---------------------------
 
      procedure Output_Attribute_Name (Name : Name_Id; Indent : Natural) is
      begin
         if Backward_Compatibility then
            case Name is
               when Snames.Name_Spec =>
                  Output_Name (Snames.Name_Specification, Indent);
 
               when Snames.Name_Spec_Suffix =>
                  Output_Name (Snames.Name_Specification_Suffix, Indent);
 
               when Snames.Name_Body =>
                  Output_Name (Snames.Name_Implementation, Indent);
 
               when Snames.Name_Body_Suffix =>
                  Output_Name (Snames.Name_Implementation_Suffix, Indent);
 
               when others =>
                  Output_Name (Name, Indent);
            end case;
 
         else
            Output_Name (Name, Indent);
         end if;
      end Output_Attribute_Name;
 
      -----------------
      -- Output_Name --
      -----------------
 
      procedure Output_Name
        (Name       : Name_Id;
         Indent     : Natural;
         Capitalize : Boolean := True)
      is
         Capital : Boolean := Capitalize;
 
      begin
         if Column = 0 and then Indent /= 0 then
            Start_Line (Indent + Increment);
         end if;
 
         Get_Name_String (Name);
 
         --  If line would become too long, create new line
 
         if Column + Name_Len > Max_Line_Length then
            Write_Eol.all;
            Column := 0;
 
            if Indent /= 0 then
               Start_Line (Indent + Increment);
            end if;
         end if;
 
         for J in 1 .. Name_Len loop
            if Capital then
               Write_Char (To_Upper (Name_Buffer (J)));
            else
               Write_Char (Name_Buffer (J));
            end if;
 
            if Capitalize then
               Capital :=
                 Name_Buffer (J) = '_'
                 or else Is_Digit (Name_Buffer (J));
            end if;
         end loop;
 
         Column := Column + Name_Len;
      end Output_Name;
 
      -------------------
      -- Output_String --
      -------------------
 
      procedure Output_String (S : Name_Id; Indent : Natural) is
      begin
         if Column = 0 and then Indent /= 0 then
            Start_Line (Indent + Increment);
         end if;
 
         Get_Name_String (S);
 
         --  If line could become too long, create new line. Note that the
         --  number of characters on the line could be twice the number of
         --  character in the string (if every character is a '"') plus two
         --  (the initial and final '"').
 
         if Column + Name_Len + Name_Len + 2 > Max_Line_Length then
            Write_Eol.all;
            Column := 0;
 
            if Indent /= 0 then
               Start_Line (Indent + Increment);
            end if;
         end if;
 
         Write_Char ('"');
         Column := Column + 1;
         Get_Name_String (S);
 
         for J in 1 .. Name_Len loop
            if Name_Buffer (J) = '"' then
               Write_Char ('"');
               Write_Char ('"');
               Column := Column + 2;
            else
               Write_Char (Name_Buffer (J));
               Column := Column + 1;
            end if;
 
            --  If the string does not fit on one line, cut it in parts and
            --  concatenate.
 
            if J < Name_Len and then Column >= Max_Line_Length then
               Write_Str (""" &");
               Write_Eol.all;
               Column := 0;
               Start_Line (Indent + Increment);
               Write_Char ('"');
               Column := Column + 1;
            end if;
         end loop;
 
         Write_Char ('"');
         Column := Column + 1;
      end Output_String;
 
      procedure Output_String (S : Path_Name_Type; Indent : Natural) is
      begin
         Output_String (Name_Id (S), Indent);
      end Output_String;
 
      ----------------
      -- Start_Line --
      ----------------
 
      procedure Start_Line (Indent : Natural) is
      begin
         if not Minimize_Empty_Lines then
            Write_Str ((1 .. Indent => ' '));
            Column := Column + Indent;
         end if;
      end Start_Line;
 
      ----------------------
      -- Write_Empty_Line --
      ----------------------
 
      procedure Write_Empty_Line (Always : Boolean := False) is
      begin
         if (Always or else not Minimize_Empty_Lines)
           and then not Last_Line_Is_Empty then
            Write_Eol.all;
            Column := 0;
            Last_Line_Is_Empty := True;
         end if;
      end Write_Empty_Line;
 
      -------------------------------
      -- Write_End_Of_Line_Comment --
      -------------------------------
 
      procedure Write_End_Of_Line_Comment (Node : Project_Node_Id) is
         Value : constant Name_Id := End_Of_Line_Comment (Node, In_Tree);
 
      begin
         if Value /= No_Name then
            Write_String (" --", 0);
            Write_String (Get_Name_String (Value), 0, Truncated => True);
         end if;
 
         Write_Line ("");
      end Write_End_Of_Line_Comment;
 
      ----------------
      -- Write_Line --
      ----------------
 
      procedure Write_Line (S : String) is
      begin
         Write_String (S, 0);
         Last_Line_Is_Empty := False;
         Write_Eol.all;
         Column := 0;
      end Write_Line;
 
      ------------------
      -- Write_String --
      ------------------
 
      procedure Write_String
        (S         : String;
         Indent    : Natural;
         Truncated : Boolean := False) is
         Length : Natural := S'Length;
      begin
         if Column = 0 and then Indent /= 0 then
            Start_Line (Indent + Increment);
         end if;
 
         --  If the string would not fit on the line,
         --  start a new line.
 
         if Column + Length > Max_Line_Length then
            if Truncated then
               Length := Max_Line_Length - Column;
 
            else
               Write_Eol.all;
               Column := 0;
 
               if Indent /= 0 then
                  Start_Line (Indent + Increment);
               end if;
            end if;
         end if;
 
         Write_Str (S (S'First .. S'First + Length - 1));
         Column := Column + Length;
      end Write_String;
 
      -----------
      -- Print --
      -----------
 
      procedure Print (Node : Project_Node_Id; Indent : Natural) is
      begin
         if Present (Node) then
 
            case Kind_Of (Node, In_Tree) is
 
               when N_Project  =>
                  pragma Debug (Indicate_Tested (N_Project));
                  if Present (First_With_Clause_Of (Node, In_Tree)) then
 
                     --  with clause(s)
 
                     First_With_In_List := True;
                     Print (First_With_Clause_Of (Node, In_Tree), Indent);
                     Write_Empty_Line (Always => True);
                  end if;
 
                  Print (First_Comment_Before (Node, In_Tree), Indent);
                  Start_Line (Indent);
 
                  case Project_Qualifier_Of (Node, In_Tree) is
                     when Unspecified | Standard =>
                        null;
                     when Aggregate   =>
                        Write_String ("aggregate ", Indent);
                     when Aggregate_Library =>
                        Write_String ("aggregate library ", Indent);
                     when Library     =>
                        Write_String ("library ", Indent);
                     when Configuration =>
                        Write_String ("configuration ", Indent);
                     when Dry =>
                        Write_String ("abstract ", Indent);
                  end case;
 
                  Write_String ("project ", Indent);
 
                  if Id /= Prj.No_Project then
                     Output_Name (Id.Display_Name, Indent);
                  else
                     Output_Name (Name_Of (Node, In_Tree), Indent);
                  end if;
 
                  --  Check if this project extends another project
 
                  if Extended_Project_Path_Of (Node, In_Tree) /= No_Path then
                     Write_String (" extends ", Indent);
 
                     if Is_Extending_All (Node, In_Tree) then
                        Write_String ("all ", Indent);
                     end if;
 
                     Output_String
                       (Extended_Project_Path_Of (Node, In_Tree),
                        Indent);
                  end if;
 
                  Write_String (" is", Indent);
                  Write_End_Of_Line_Comment (Node);
                  Print
                    (First_Comment_After (Node, In_Tree), Indent + Increment);
                  Write_Empty_Line (Always => True);
 
                  --  Output all of the declarations in the project
 
                  Print (Project_Declaration_Of (Node, In_Tree), Indent);
                  Print
                    (First_Comment_Before_End (Node, In_Tree),
                     Indent + Increment);
                  Start_Line (Indent);
                  Write_String ("end ", Indent);
 
                  if Id /= Prj.No_Project then
                     Output_Name (Id.Display_Name, Indent);
                  else
                     Output_Name (Name_Of (Node, In_Tree), Indent);
                  end if;
 
                  Write_Line (";");
                  Print (First_Comment_After_End (Node, In_Tree), Indent);
 
               when N_With_Clause =>
                  pragma Debug (Indicate_Tested (N_With_Clause));
 
                  --  The with clause will sometimes contain an invalid name
                  --  when we are importing a virtual project from an
                  --  extending all project. Do not output anything in this
                  --  case
 
                  if Name_Of (Node, In_Tree) /= No_Name
                    and then String_Value_Of (Node, In_Tree) /= No_Name
                  then
                     if First_With_In_List then
                        Print (First_Comment_Before (Node, In_Tree), Indent);
                        Start_Line (Indent);
 
                        if Non_Limited_Project_Node_Of (Node, In_Tree) =
                             Empty_Node
                        then
                           Write_String ("limited ", Indent);
                        end if;
 
                        Write_String ("with ", Indent);
                     end if;
 
                     Output_String (String_Value_Of (Node, In_Tree), Indent);
 
                     if Is_Not_Last_In_List (Node, In_Tree) then
                        Write_String (", ", Indent);
                        First_With_In_List := False;
 
                     else
                        Write_String (";", Indent);
                        Write_End_Of_Line_Comment (Node);
                        Print (First_Comment_After (Node, In_Tree), Indent);
                        First_With_In_List := True;
                     end if;
                  end if;
 
                  Print (Next_With_Clause_Of (Node, In_Tree), Indent);
 
               when N_Project_Declaration =>
                  pragma Debug (Indicate_Tested (N_Project_Declaration));
 
                  if
                    Present (First_Declarative_Item_Of (Node, In_Tree))
                  then
                     Print
                       (First_Declarative_Item_Of (Node, In_Tree),
                        Indent + Increment);
                     Write_Empty_Line (Always => True);
                  end if;
 
               when N_Declarative_Item =>
                  pragma Debug (Indicate_Tested (N_Declarative_Item));
                  Print (Current_Item_Node (Node, In_Tree), Indent);
                  Print (Next_Declarative_Item (Node, In_Tree), Indent);
 
               when N_Package_Declaration =>
                  pragma Debug (Indicate_Tested (N_Package_Declaration));
                  Write_Empty_Line (Always => True);
                  Print (First_Comment_Before (Node, In_Tree), Indent);
                  Start_Line (Indent);
                  Write_String ("package ", Indent);
                  Output_Name (Name_Of (Node, In_Tree), Indent);
 
                  if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
                       Empty_Node
                  then
                     Write_String (" renames ", Indent);
                     Output_Name
                       (Name_Of
                          (Project_Of_Renamed_Package_Of (Node, In_Tree),
                           In_Tree),
                        Indent);
                     Write_String (".", Indent);
                     Output_Name (Name_Of (Node, In_Tree), Indent);
                     Write_String (";", Indent);
                     Write_End_Of_Line_Comment (Node);
                     Print (First_Comment_After_End (Node, In_Tree), Indent);
 
                  else
                     Write_String (" is", Indent);
                     Write_End_Of_Line_Comment (Node);
                     Print (First_Comment_After (Node, In_Tree),
                            Indent + Increment);
 
                     if First_Declarative_Item_Of (Node, In_Tree) /=
                          Empty_Node
                     then
                        Print
                          (First_Declarative_Item_Of (Node, In_Tree),
                           Indent + Increment);
                     end if;
 
                     Print (First_Comment_Before_End (Node, In_Tree),
                            Indent + Increment);
                     Start_Line (Indent);
                     Write_String ("end ", Indent);
                     Output_Name (Name_Of (Node, In_Tree), Indent);
                     Write_Line (";");
                     Print (First_Comment_After_End (Node, In_Tree), Indent);
                     Write_Empty_Line;
                  end if;
 
               when N_String_Type_Declaration =>
                  pragma Debug (Indicate_Tested (N_String_Type_Declaration));
                  Print (First_Comment_Before (Node, In_Tree), Indent);
                  Start_Line (Indent);
                  Write_String ("type ", Indent);
                  Output_Name (Name_Of (Node, In_Tree), Indent);
                  Write_Line (" is");
                  Start_Line (Indent + Increment);
                  Write_String ("(", Indent);
 
                  declare
                     String_Node : Project_Node_Id :=
                       First_Literal_String (Node, In_Tree);
 
                  begin
                     while Present (String_Node) loop
                        Output_String
                          (String_Value_Of (String_Node, In_Tree),
                           Indent);
                        String_Node :=
                          Next_Literal_String (String_Node, In_Tree);
 
                        if Present (String_Node) then
                           Write_String (", ", Indent);
                        end if;
                     end loop;
                  end;
 
                  Write_String (");", Indent);
                  Write_End_Of_Line_Comment (Node);
                  Print (First_Comment_After (Node, In_Tree), Indent);
 
               when N_Literal_String =>
                  pragma Debug (Indicate_Tested (N_Literal_String));
                  Output_String (String_Value_Of (Node, In_Tree), Indent);
 
                  if Source_Index_Of (Node, In_Tree) /= 0 then
                     Write_String (" at", Indent);
                     Write_String
                       (Source_Index_Of (Node, In_Tree)'Img,
                        Indent);
                  end if;
 
               when N_Attribute_Declaration =>
                  pragma Debug (Indicate_Tested (N_Attribute_Declaration));
                  Print (First_Comment_Before (Node, In_Tree), Indent);
                  Start_Line (Indent);
                  Write_String ("for ", Indent);
                  Output_Attribute_Name (Name_Of (Node, In_Tree), Indent);
 
                  if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then
                     Write_String (" (", Indent);
                     Output_String
                       (Associative_Array_Index_Of (Node, In_Tree),
                        Indent);
 
                     if Source_Index_Of (Node, In_Tree) /= 0 then
                        Write_String (" at", Indent);
                        Write_String
                          (Source_Index_Of (Node, In_Tree)'Img,
                           Indent);
                     end if;
 
                     Write_String (")", Indent);
                  end if;
 
                  Write_String (" use ", Indent);
 
                  if Present (Expression_Of (Node, In_Tree)) then
                     Print (Expression_Of (Node, In_Tree), Indent);
 
                  else
                     --  Full associative array declaration
 
                     if
                       Present (Associative_Project_Of (Node, In_Tree))
                     then
                        Output_Name
                          (Name_Of
                             (Associative_Project_Of (Node, In_Tree),
                              In_Tree),
                           Indent);
 
                        if
                          Present (Associative_Package_Of (Node, In_Tree))
                        then
                           Write_String (".", Indent);
                           Output_Name
                             (Name_Of
                                (Associative_Package_Of (Node, In_Tree),
                                 In_Tree),
                              Indent);
                        end if;
 
                     elsif
                       Present (Associative_Package_Of (Node, In_Tree))
                     then
                        Output_Name
                          (Name_Of
                             (Associative_Package_Of (Node, In_Tree),
                              In_Tree),
                           Indent);
                     end if;
 
                     Write_String ("'", Indent);
                     Output_Attribute_Name (Name_Of (Node, In_Tree), Indent);
                  end if;
 
                  Write_String (";", Indent);
                  Write_End_Of_Line_Comment (Node);
                  Print (First_Comment_After (Node, In_Tree), Indent);
 
               when N_Typed_Variable_Declaration =>
                  pragma Debug
                    (Indicate_Tested (N_Typed_Variable_Declaration));
                  Print (First_Comment_Before (Node, In_Tree), Indent);
                  Start_Line (Indent);
                  Output_Name (Name_Of (Node, In_Tree), Indent);
                  Write_String (" : ", Indent);
                  Output_Name
                    (Name_Of (String_Type_Of (Node, In_Tree), In_Tree),
                     Indent);
                  Write_String (" := ", Indent);
                  Print (Expression_Of (Node, In_Tree), Indent);
                  Write_String (";", Indent);
                  Write_End_Of_Line_Comment (Node);
                  Print (First_Comment_After (Node, In_Tree), Indent);
 
               when N_Variable_Declaration =>
                  pragma Debug (Indicate_Tested (N_Variable_Declaration));
                  Print (First_Comment_Before (Node, In_Tree), Indent);
                  Start_Line (Indent);
                  Output_Name (Name_Of (Node, In_Tree), Indent);
                  Write_String (" := ", Indent);
                  Print (Expression_Of (Node, In_Tree), Indent);
                  Write_String (";", Indent);
                  Write_End_Of_Line_Comment (Node);
                  Print (First_Comment_After (Node, In_Tree), Indent);
 
               when N_Expression =>
                  pragma Debug (Indicate_Tested (N_Expression));
                  declare
                     Term : Project_Node_Id := First_Term (Node, In_Tree);
 
                  begin
                     while Present (Term) loop
                        Print (Term, Indent);
                        Term := Next_Term (Term, In_Tree);
 
                        if Present (Term) then
                           Write_String (" & ", Indent);
                        end if;
                     end loop;
                  end;
 
               when N_Term =>
                  pragma Debug (Indicate_Tested (N_Term));
                  Print (Current_Term (Node, In_Tree), Indent);
 
               when N_Literal_String_List =>
                  pragma Debug (Indicate_Tested (N_Literal_String_List));
                  Write_String ("(", Indent);
 
                  declare
                     Expression : Project_Node_Id :=
                       First_Expression_In_List (Node, In_Tree);
 
                  begin
                     while Present (Expression) loop
                        Print (Expression, Indent);
                        Expression :=
                          Next_Expression_In_List (Expression, In_Tree);
 
                        if Present (Expression) then
                           Write_String (", ", Indent);
                        end if;
                     end loop;
                  end;
 
                  Write_String (")", Indent);
 
               when N_Variable_Reference =>
                  pragma Debug (Indicate_Tested (N_Variable_Reference));
                  if Present (Project_Node_Of (Node, In_Tree)) then
                     Output_Name
                       (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree),
                        Indent);
                     Write_String (".", Indent);
                  end if;
 
                  if Present (Package_Node_Of (Node, In_Tree)) then
                     Output_Name
                       (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree),
                        Indent);
                     Write_String (".", Indent);
                  end if;
 
                  Output_Name (Name_Of (Node, In_Tree), Indent);
 
               when N_External_Value =>
                  pragma Debug (Indicate_Tested (N_External_Value));
                  Write_String ("external (", Indent);
                  Print (External_Reference_Of (Node, In_Tree), Indent);
 
                  if Present (External_Default_Of (Node, In_Tree)) then
                     Write_String (", ", Indent);
                     Print (External_Default_Of (Node, In_Tree), Indent);
                  end if;
 
                  Write_String (")", Indent);
 
               when N_Attribute_Reference =>
                  pragma Debug (Indicate_Tested (N_Attribute_Reference));
 
                  if Present (Project_Node_Of (Node, In_Tree))
                    and then Project_Node_Of (Node, In_Tree) /= Project
                  then
                     Output_Name
                       (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree),
                        Indent);
 
                     if Present (Package_Node_Of (Node, In_Tree)) then
                        Write_String (".", Indent);
                        Output_Name
                          (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree),
                           Indent);
                     end if;
 
                  elsif Present (Package_Node_Of (Node, In_Tree)) then
                     Output_Name
                       (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree),
                        Indent);
 
                  else
                     Write_String ("project", Indent);
                  end if;
 
                  Write_String ("'", Indent);
                  Output_Attribute_Name (Name_Of (Node, In_Tree), Indent);
 
                  declare
                     Index : constant Name_Id :=
                               Associative_Array_Index_Of (Node, In_Tree);
 
                  begin
                     if Index /= No_Name then
                        Write_String (" (", Indent);
                        Output_String (Index, Indent);
                        Write_String (")", Indent);
                     end if;
                  end;
 
               when N_Case_Construction =>
                  pragma Debug (Indicate_Tested (N_Case_Construction));
 
                  declare
                     Case_Item    : Project_Node_Id;
                     Is_Non_Empty : Boolean := False;
 
                  begin
                     Case_Item := First_Case_Item_Of (Node, In_Tree);
                     while Present (Case_Item) loop
                        if Present
                            (First_Declarative_Item_Of (Case_Item, In_Tree))
                           or else not Eliminate_Empty_Case_Constructions
                        then
                           Is_Non_Empty := True;
                           exit;
                        end if;
 
                        Case_Item := Next_Case_Item (Case_Item, In_Tree);
                     end loop;
 
                     if Is_Non_Empty then
                        Write_Empty_Line;
                        Print (First_Comment_Before (Node, In_Tree), Indent);
                        Start_Line (Indent);
                        Write_String ("case ", Indent);
                        Print
                          (Case_Variable_Reference_Of (Node, In_Tree),
                           Indent);
                        Write_String (" is", Indent);
                        Write_End_Of_Line_Comment (Node);
                        Print
                          (First_Comment_After (Node, In_Tree),
                           Indent + Increment);
 
                        declare
                           Case_Item : Project_Node_Id :=
                                         First_Case_Item_Of (Node, In_Tree);
                        begin
                           while Present (Case_Item) loop
                              pragma Assert
                                (Kind_Of (Case_Item, In_Tree) = N_Case_Item);
                              Print (Case_Item, Indent + Increment);
                              Case_Item :=
                                Next_Case_Item (Case_Item, In_Tree);
                           end loop;
                        end;
 
                        Print (First_Comment_Before_End (Node, In_Tree),
                               Indent + Increment);
                        Start_Line (Indent);
                        Write_Line ("end case;");
                        Print
                          (First_Comment_After_End (Node, In_Tree), Indent);
                     end if;
                  end;
 
               when N_Case_Item =>
                  pragma Debug (Indicate_Tested (N_Case_Item));
 
                  if Present (First_Declarative_Item_Of (Node, In_Tree))
                    or else not Eliminate_Empty_Case_Constructions
                  then
                     Write_Empty_Line;
                     Print (First_Comment_Before (Node, In_Tree), Indent);
                     Start_Line (Indent);
                     Write_String ("when ", Indent);
 
                     if No (First_Choice_Of (Node, In_Tree)) then
                        Write_String ("others", Indent);
 
                     else
                        declare
                           Label : Project_Node_Id :=
                                     First_Choice_Of (Node, In_Tree);
                        begin
                           while Present (Label) loop
                              Print (Label, Indent);
                              Label := Next_Literal_String (Label, In_Tree);
 
                              if Present (Label) then
                                 Write_String (" | ", Indent);
                              end if;
                           end loop;
                        end;
                     end if;
 
                     Write_String (" =>", Indent);
                     Write_End_Of_Line_Comment (Node);
                     Print
                       (First_Comment_After (Node, In_Tree),
                        Indent + Increment);
 
                     declare
                        First : constant Project_Node_Id :=
                                  First_Declarative_Item_Of (Node, In_Tree);
                     begin
                        if No (First) then
                           Write_Empty_Line;
                        else
                           Print (First, Indent + Increment);
                        end if;
                     end;
                  end if;
 
               when N_Comment_Zones =>
 
               --  Nothing to do, because it will not be processed directly
 
                  null;
 
               when N_Comment =>
                  pragma Debug (Indicate_Tested (N_Comment));
 
                  if Follows_Empty_Line (Node, In_Tree) then
                     Write_Empty_Line;
                  end if;
 
                  Start_Line (Indent);
                  Write_String ("--", Indent);
                  Write_String
                    (Get_Name_String (String_Value_Of (Node, In_Tree)),
                     Indent,
                     Truncated => True);
                  Write_Line ("");
 
                  if Is_Followed_By_Empty_Line (Node, In_Tree) then
                     Write_Empty_Line;
                  end if;
 
                  Print (Next_Comment (Node, In_Tree), Indent);
            end case;
         end if;
      end Print;
 
   --  Start of processing for Pretty_Print
 
   begin
      if W_Char = null then
         Write_Char := Output.Write_Char'Access;
      else
         Write_Char := W_Char;
      end if;
 
      if W_Eol = null then
         Write_Eol := Output.Write_Eol'Access;
      else
         Write_Eol := W_Eol;
      end if;
 
      if W_Str = null then
         Write_Str := Output.Write_Str'Access;
      else
         Write_Str := W_Str;
      end if;
 
      Print (Project, 0);
   end Pretty_Print;
 
   -----------------------
   -- Output_Statistics --
   -----------------------
 
   procedure Output_Statistics is
   begin
      Output.Write_Line ("Project_Node_Kinds not tested:");
 
      for Kind in Project_Node_Kind loop
         if Kind /= N_Comment_Zones and then Not_Tested (Kind) then
            Output.Write_Str ("   ");
            Output.Write_Line (Project_Node_Kind'Image (Kind));
         end if;
      end loop;
 
      Output.Write_Eol;
   end Output_Statistics;
 
   ---------
   -- wpr --
   ---------
 
   procedure wpr
     (Project : Prj.Tree.Project_Node_Id;
      In_Tree : Prj.Tree.Project_Node_Tree_Ref) is
   begin
      Pretty_Print (Project, In_Tree, Backward_Compatibility => False);
   end wpr;
 
end Prj.PP;