[thirdparty/gcc.git] / gcc / ada / prj-pp.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                               P R J . P P                                --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                                                                          --
--             Copyright (C) 2001-2002 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 2,  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 COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;

with Hostparm;
with Namet;     use Namet;
with Output;    use Output;
with Stringt;   use Stringt;

package body Prj.PP is

   use Prj.Tree;

   Not_Tested : array (Project_Node_Kind) of Boolean := (others => True);

   Max_Line_Length : constant := Hostparm.Max_Line_Length - 5;
   --  Maximum length of a line.

   Column : Natural := 0;
   --  Column number of the last character in the line. Used to avoid
   --  outputing lines longer than Max_Line_Length.

   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;
      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) 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_Name (Name : Name_Id; Capitalize : Boolean := True);
      --  Outputs a name

      procedure Start_Line (Indent : Natural);
      --  Outputs the indentation at the beginning of the line.

      procedure Output_String (S : String_Id);
      --  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);
      --  Outputs S using Write_Str, starting a new line if line would
      --  become too long.

      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 two access to procedure values are used for the output.

      Last_Line_Is_Empty : Boolean := False;
      --  Used to avoid two consecutive empty lines.

      -----------------
      -- Output_Name --
      -----------------

      procedure Output_Name (Name : Name_Id; Capitalize : Boolean := True) is
         Capital : Boolean := Capitalize;

      begin
         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;
         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;
      end Output_Name;

      -------------------
      -- Output_String --
      -------------------

      procedure Output_String (S : String_Id) is
      begin
         String_To_Name_Buffer (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;
         end if;

         Write_Char ('"');
         Column := Column + 1;
         String_To_Name_Buffer (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;
               Write_Char ('"');
               Column := 1;
            end if;
         end loop;

         Write_Char ('"');
         Column := Column + 1;
      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_Line --
      ----------------

      procedure Write_Line (S : String) is
      begin
         Write_String (S);
         Last_Line_Is_Empty := False;
         Write_Eol.all;
         Column := 0;
      end Write_Line;

      ------------------
      -- Write_String --
      ------------------

      procedure Write_String (S : String) is
      begin
         --  If the string would not fit on the line,
         --  start a new line.

         if Column + S'Length > Max_Line_Length then
            Write_Eol.all;
            Column := 0;
         end if;

         Write_Str (S);
         Column := Column + S'Length;
      end Write_String;

      -----------
      -- Print --
      -----------

      procedure Print (Node   : Project_Node_Id; Indent : Natural) is
      begin
         if Node /= Empty_Node then

            case Kind_Of (Node) is

               when N_Project  =>
                  pragma Debug (Indicate_Tested (N_Project));
                  if First_With_Clause_Of (Node) /= Empty_Node then

                     --  with clause(s)

                     Print (First_With_Clause_Of (Node), Indent);
                     Write_Empty_Line (Always => True);
                  end if;

                  Start_Line (Indent);
                  Write_String ("project ");
                  Output_Name (Name_Of (Node));

                  --  Check if this project modifies another project

                  if Modified_Project_Path_Of (Node) /= No_String then
                     Write_String (" extends ");
                     Output_String (Modified_Project_Path_Of (Node));
                  end if;

                  Write_Line (" is");
                  Write_Empty_Line (Always => True);

                  --  Output all of the declarations in the project

                  Print (Project_Declaration_Of (Node), Indent);
                  Start_Line (Indent);
                  Write_String ("end ");
                  Output_Name (Name_Of (Node));
                  Write_Line (";");

               when N_With_Clause =>
                  pragma Debug (Indicate_Tested (N_With_Clause));

                  if Name_Of (Node) /= No_Name then
                     Start_Line (Indent);
                     Write_String ("with ");
                     Output_String (String_Value_Of (Node));
                     Write_Line (";");
                  end if;

                  Print (Next_With_Clause_Of (Node), Indent);

               when N_Project_Declaration =>
                  pragma Debug (Indicate_Tested (N_Project_Declaration));

                  if First_Declarative_Item_Of (Node) /= Empty_Node then
                     Print
                       (First_Declarative_Item_Of (Node), 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), Indent);
                  Print (Next_Declarative_Item (Node), Indent);

               when N_Package_Declaration =>
                  pragma Debug (Indicate_Tested (N_Package_Declaration));
                  Write_Empty_Line (Always => True);
                  Start_Line (Indent);
                  Write_String ("package ");
                  Output_Name (Name_Of (Node));

                  if Project_Of_Renamed_Package_Of (Node) /= Empty_Node then
                     Write_String (" renames ");
                     Output_Name
                       (Name_Of (Project_Of_Renamed_Package_Of (Node)));
                     Write_String (".");
                     Output_Name (Name_Of (Node));
                     Write_Line (";");

                  else
                     Write_Line (" is");

                     if First_Declarative_Item_Of (Node) /= Empty_Node then
                        Print
                          (First_Declarative_Item_Of (Node),
                           Indent + Increment);
                     end if;

                     Start_Line (Indent);
                     Write_String ("end ");
                     Output_Name (Name_Of (Node));
                     Write_Line (";");
                     Write_Empty_Line;
                  end if;

               when N_String_Type_Declaration =>
                  pragma Debug (Indicate_Tested (N_String_Type_Declaration));
                  Start_Line (Indent);
                  Write_String ("type ");
                  Output_Name (Name_Of (Node));
                  Write_Line (" is");
                  Start_Line (Indent + Increment);
                  Write_String ("(");

                  declare
                     String_Node : Project_Node_Id :=
                       First_Literal_String (Node);

                  begin
                     while String_Node /= Empty_Node loop
                        Output_String (String_Value_Of (String_Node));
                        String_Node := Next_Literal_String (String_Node);

                        if String_Node /= Empty_Node then
                           Write_String (", ");
                        end if;
                     end loop;
                  end;

                  Write_Line (");");

               when N_Literal_String =>
                  pragma Debug (Indicate_Tested (N_Literal_String));
                  Output_String (String_Value_Of (Node));

               when N_Attribute_Declaration =>
                  pragma Debug (Indicate_Tested (N_Attribute_Declaration));
                  Start_Line (Indent);
                  Write_String ("for ");
                  Output_Name (Name_Of (Node));

                  if Associative_Array_Index_Of (Node) /= No_String then
                     Write_String (" (");
                     Output_String (Associative_Array_Index_Of (Node));
                     Write_String (")");
                  end if;

                  Write_String (" use ");
                  Print (Expression_Of (Node), Indent);
                  Write_Line (";");

               when N_Typed_Variable_Declaration =>
                  pragma Debug
                    (Indicate_Tested (N_Typed_Variable_Declaration));
                  Start_Line (Indent);
                  Output_Name (Name_Of (Node));
                  Write_String (" : ");
                  Output_Name (Name_Of (String_Type_Of (Node)));
                  Write_String (" := ");
                  Print (Expression_Of (Node), Indent);
                  Write_Line (";");

               when N_Variable_Declaration =>
                  pragma Debug (Indicate_Tested (N_Variable_Declaration));
                  Start_Line (Indent);
                  Output_Name (Name_Of (Node));
                  Write_String (" := ");
                  Print (Expression_Of (Node), Indent);
                  Write_Line (";");

               when N_Expression =>
                  pragma Debug (Indicate_Tested (N_Expression));
                  declare
                     Term : Project_Node_Id := First_Term (Node);

                  begin
                     while Term /= Empty_Node loop
                        Print (Term, Indent);
                        Term := Next_Term (Term);

                        if Term /= Empty_Node then
                           Write_String (" & ");
                        end if;
                     end loop;
                  end;

               when N_Term =>
                  pragma Debug (Indicate_Tested (N_Term));
                  Print (Current_Term (Node), Indent);

               when N_Literal_String_List =>
                  pragma Debug (Indicate_Tested (N_Literal_String_List));
                  Write_String ("(");

                  declare
                     Expression : Project_Node_Id :=
                       First_Expression_In_List (Node);

                  begin
                     while Expression /= Empty_Node loop
                        Print (Expression, Indent);
                        Expression := Next_Expression_In_List (Expression);

                        if Expression /= Empty_Node then
                           Write_String (", ");
                        end if;
                     end loop;
                  end;

                  Write_String (")");

               when N_Variable_Reference =>
                  pragma Debug (Indicate_Tested (N_Variable_Reference));
                  if Project_Node_Of (Node) /= Empty_Node then
                     Output_Name (Name_Of (Project_Node_Of (Node)));
                     Write_String (".");
                  end if;

                  if Package_Node_Of (Node) /= Empty_Node then
                     Output_Name (Name_Of (Package_Node_Of (Node)));
                     Write_String (".");
                  end if;

                  Output_Name (Name_Of (Node));

               when N_External_Value =>
                  pragma Debug (Indicate_Tested (N_External_Value));
                  Write_String ("external (");
                  Print (External_Reference_Of (Node), Indent);

                  if External_Default_Of (Node) /= Empty_Node then
                     Write_String (", ");
                     Print (External_Default_Of (Node), Indent);
                  end if;

                  Write_String (")");

               when N_Attribute_Reference =>
                  pragma Debug (Indicate_Tested (N_Attribute_Reference));

                  if Project_Node_Of (Node) /= Empty_Node
                    and then Project_Node_Of (Node) /= Project
                  then
                     Output_Name (Name_Of (Project_Node_Of (Node)));

                     if Package_Node_Of (Node) /= Empty_Node then
                        Write_String (".");
                        Output_Name (Name_Of (Package_Node_Of (Node)));
                     end if;

                  elsif Package_Node_Of (Node) /= Empty_Node then
                     Output_Name (Name_Of (Package_Node_Of (Node)));

                  else
                     Write_String ("project");
                  end if;

                  Write_String ("'");
                  Output_Name (Name_Of (Node));

                  declare
                     Index : constant String_Id :=
                       Associative_Array_Index_Of (Node);

                  begin
                     if Index /= No_String then
                        Write_String (" (");
                        Output_String (Index);
                        Write_String (")");
                     end if;
                  end;

               when N_Case_Construction =>
                  pragma Debug (Indicate_Tested (N_Case_Construction));

                  declare
                     Case_Item : Project_Node_Id := First_Case_Item_Of (Node);
                     Is_Non_Empty : Boolean := False;
                  begin
                     while Case_Item /= Empty_Node loop
                        if First_Declarative_Item_Of (Case_Item) /= Empty_Node
                          or else not Eliminate_Empty_Case_Constructions
                        then
                           Is_Non_Empty := True;
                           exit;
                        end if;
                        Case_Item := Next_Case_Item (Case_Item);
                     end loop;

                     if Is_Non_Empty then
                        Write_Empty_Line;
                        Start_Line (Indent);
                        Write_String ("case ");
                        Print (Case_Variable_Reference_Of (Node), Indent);
                        Write_Line (" is");

                        declare
                           Case_Item : Project_Node_Id :=
                             First_Case_Item_Of (Node);

                        begin
                           while Case_Item /= Empty_Node loop
                              pragma Assert
                                (Kind_Of (Case_Item) = N_Case_Item);
                              Print (Case_Item, Indent + Increment);
                              Case_Item := Next_Case_Item (Case_Item);
                           end loop;
                        end;

                        Start_Line (Indent);
                        Write_Line ("end case;");
                     end if;
                  end;

               when N_Case_Item =>
                  pragma Debug (Indicate_Tested (N_Case_Item));

                  if First_Declarative_Item_Of (Node) /= Empty_Node
                    or else not Eliminate_Empty_Case_Constructions
                  then
                     Write_Empty_Line;
                     Start_Line (Indent);
                     Write_String ("when ");

                     if First_Choice_Of (Node) = Empty_Node then
                        Write_String ("others");

                     else
                        declare
                           Label : Project_Node_Id := First_Choice_Of (Node);

                        begin
                           while Label /= Empty_Node loop
                              Print (Label, Indent);
                              Label := Next_Literal_String (Label);

                              if Label /= Empty_Node then
                                 Write_String (" | ");
                              end if;
                           end loop;
                        end;
                     end if;

                     Write_Line (" =>");

                     declare
                        First : Project_Node_Id :=
                          First_Declarative_Item_Of (Node);

                     begin
                        if First = Empty_Node then
                           Write_Eol.all;

                        else
                           Print (First, Indent + Increment);
                        end if;
                     end;
                  end if;
            end case;
         end if;
      end 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);

      if W_Char = null or else W_Str = null then
         Output.Write_Eol;
      end if;
   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 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;

end Prj.PP;
Commit	Line	Data
792c4e74 GB	1	------------------------------------------------------------------------------
	2	-- --
	3	-- GNAT COMPILER COMPONENTS --
	4	-- --
	5	-- P R J . P P --
	6	-- --
	7	-- B o d y --
	8	-- --
792c4e74 GB	9	-- --
	10	-- Copyright (C) 2001-2002 Free Software Foundation, Inc. --
	11	-- --
	12	-- GNAT is free software; you can redistribute it and/or modify it under --
	13	-- terms of the GNU General Public License as published by the Free Soft- --
	14	-- ware Foundation; either version 2, or (at your option) any later ver- --
	15	-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
	16	-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
	17	-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
	18	-- for more details. You should have received a copy of the GNU General --
	19	-- Public License distributed with GNAT; see file COPYING. If not, write --
	20	-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
	21	-- MA 02111-1307, USA. --
	22	-- --
	23	-- GNAT was originally developed by the GNAT team at New York University. --
	24	-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
	25	-- --
	26	------------------------------------------------------------------------------
	27
	28	with Ada.Characters.Handling; use Ada.Characters.Handling;
	29
	30	with Hostparm;
	31	with Namet; use Namet;
	32	with Output; use Output;
	33	with Stringt; use Stringt;
	34
	35	package body Prj.PP is
	36
	37	use Prj.Tree;
	38
	39	Not_Tested : array (Project_Node_Kind) of Boolean := (others => True);
	40
	41	Max_Line_Length : constant := Hostparm.Max_Line_Length - 5;
	42	-- Maximum length of a line.
	43
	44	Column : Natural := 0;
	45	-- Column number of the last character in the line. Used to avoid
	46	-- outputing lines longer than Max_Line_Length.
	47
	48	procedure Indicate_Tested (Kind : Project_Node_Kind);
	49	-- Set the corresponding component of array Not_Tested to False.
	50	-- Only called by pragmas Debug.
	51	--
	52
	53	---------------------
	54	-- Indicate_Tested --
	55	---------------------
	56
	57	procedure Indicate_Tested (Kind : Project_Node_Kind) is
	58	begin
	59	Not_Tested (Kind) := False;
	60	end Indicate_Tested;
	61
	62	------------------
	63	-- Pretty_Print --
	64	------------------
	65
	66	procedure Pretty_Print
	67	(Project : Prj.Tree.Project_Node_Id;
	68	Increment : Positive := 3;
	69	Eliminate_Empty_Case_Constructions : Boolean := False;
	70	Minimize_Empty_Lines : Boolean := False;
	71	W_Char : Write_Char_Ap := null;
	72	W_Eol : Write_Eol_Ap := null;
73	W_Str : Write_Str_Ap := null) is
74
75	procedure Print (Node : Project_Node_Id; Indent : Natural);
76	-- A recursive procedure that traverses a project file tree
77	-- and outputs its source.
78	-- Current_Prj is the project that we are printing. This
79	-- is used when printing attributes, since in nested packages they need
80	-- to use a fully qualified name.
81
82	procedure Output_Name (Name : Name_Id; Capitalize : Boolean := True);
83	-- Outputs a name
84
85	procedure Start_Line (Indent : Natural);
86	-- Outputs the indentation at the beginning of the line.
87
88	procedure Output_String (S : String_Id);
89	-- Outputs a string using the default output procedures
90
91	procedure Write_Empty_Line (Always : Boolean := False);
92	-- Outputs an empty line, only if the previous line was not
93	-- empty already and either Always is True or Minimize_Empty_Lines
94	-- is False.
95
96	procedure Write_Line (S : String);
97	-- Outputs S followed by a new line
98
99	procedure Write_String (S : String);
100	-- Outputs S using Write_Str, starting a new line if line would
101	-- become too long.
102
103	Write_Char : Write_Char_Ap := Output.Write_Char'Access;
104	Write_Eol : Write_Eol_Ap := Output.Write_Eol'Access;
105	Write_Str : Write_Str_Ap := Output.Write_Str'Access;
106	-- These two access to procedure values are used for the output.
107
108	Last_Line_Is_Empty : Boolean := False;
109	-- Used to avoid two consecutive empty lines.
110
111	-----------------
112	-- Output_Name --
113	-----------------
114
115	procedure Output_Name (Name : Name_Id; Capitalize : Boolean := True) is
116	Capital : Boolean := Capitalize;
117
118	begin
119	Get_Name_String (Name);
120
121	-- If line would become too long, create new line
122
123	if Column + Name_Len > Max_Line_Length then
124	Write_Eol.all;
125	Column := 0;
126	end if;
127
128	for J in 1 .. Name_Len loop
129	if Capital then
130	Write_Char (To_Upper (Name_Buffer (J)));
131	else
132	Write_Char (Name_Buffer (J));
133	end if;
134
135	if Capitalize then
136	Capital :=
137	Name_Buffer (J) = '_'
138	or else Is_Digit (Name_Buffer (J));
139	end if;
140	end loop;
141	end Output_Name;
142
143	-------------------
144	-- Output_String --
145	-------------------
146
147	procedure Output_String (S : String_Id) is
148	begin
149	String_To_Name_Buffer (S);
150
151	-- If line could become too long, create new line.
152	-- Note that the number of characters on the line could be
153	-- twice the number of character in the string (if every
154	-- character is a '"') plus two (the initial and final '"').
155
156	if Column + Name_Len + Name_Len + 2 > Max_Line_Length then
157	Write_Eol.all;
158	Column := 0;
159	end if;
160
161	Write_Char ('"');
162	Column := Column + 1;
163	String_To_Name_Buffer (S);
164
165	for J in 1 .. Name_Len loop
166	if Name_Buffer (J) = '"' then
167	Write_Char ('"');
168	Write_Char ('"');
169	Column := Column + 2;
170	else
171	Write_Char (Name_Buffer (J));
172	Column := Column + 1;
173	end if;
174
175	-- If the string does not fit on one line, cut it in parts
176	-- and concatenate.
177
178	if J < Name_Len and then Column >= Max_Line_Length then
179	Write_Str (""" &");
180	Write_Eol.all;
181	Write_Char ('"');
182	Column := 1;
183	end if;
184	end loop;
185
186	Write_Char ('"');
187	Column := Column + 1;
188	end Output_String;
189
190	----------------
191	-- Start_Line --
192	----------------
193
194	procedure Start_Line (Indent : Natural) is
195	begin
196	if not Minimize_Empty_Lines then
197	Write_Str ((1 .. Indent => ' '));
198	Column := Column + Indent;
199	end if;
200	end Start_Line;
201
202	----------------------
203	-- Write_Empty_Line --
204	----------------------
205
206	procedure Write_Empty_Line (Always : Boolean := False) is
207	begin
208	if (Always or else not Minimize_Empty_Lines)
209	and then not Last_Line_Is_Empty then
210	Write_Eol.all;
211	Column := 0;
212	Last_Line_Is_Empty := True;
213	end if;
214	end Write_Empty_Line;
215
216	----------------
217	-- Write_Line --
218	----------------
219
220	procedure Write_Line (S : String) is
221	begin
222	Write_String (S);
223	Last_Line_Is_Empty := False;
224	Write_Eol.all;
225	Column := 0;
226	end Write_Line;
227
228	------------------
229	-- Write_String --
230	------------------
231
232	procedure Write_String (S : String) is
233	begin
234	-- If the string would not fit on the line,
235	-- start a new line.
236
237	if Column + S'Length > Max_Line_Length then
238	Write_Eol.all;
239	Column := 0;
240	end if;
241
242	Write_Str (S);
243	Column := Column + S'Length;
244	end Write_String;
245
246	-----------
247	-- Print --
248	-----------
249
250	procedure Print (Node : Project_Node_Id; Indent : Natural) is
251	begin
252	if Node /= Empty_Node then
253
254	case Kind_Of (Node) is
255
256	when N_Project =>
257	pragma Debug (Indicate_Tested (N_Project));
258	if First_With_Clause_Of (Node) /= Empty_Node then
259
260	-- with clause(s)
261
262	Print (First_With_Clause_Of (Node), Indent);
263	Write_Empty_Line (Always => True);
264	end if;
265
266	Start_Line (Indent);
267	Write_String ("project ");
268	Output_Name (Name_Of (Node));
269
270	-- Check if this project modifies another project
271
272	if Modified_Project_Path_Of (Node) /= No_String then
273	Write_String (" extends ");
274	Output_String (Modified_Project_Path_Of (Node));
275	end if;
276
277	Write_Line (" is");
278	Write_Empty_Line (Always => True);
279
280	-- Output all of the declarations in the project
281
282	Print (Project_Declaration_Of (Node), Indent);
283	Start_Line (Indent);
284	Write_String ("end ");
285	Output_Name (Name_Of (Node));
286	Write_Line (";");
287
288	when N_With_Clause =>
289	pragma Debug (Indicate_Tested (N_With_Clause));
290
291	if Name_Of (Node) /= No_Name then
292	Start_Line (Indent);
293	Write_String ("with ");
294	Output_String (String_Value_Of (Node));
295	Write_Line (";");
296	end if;
297
298	Print (Next_With_Clause_Of (Node), Indent);
299
300	when N_Project_Declaration =>
301	pragma Debug (Indicate_Tested (N_Project_Declaration));
302
303	if First_Declarative_Item_Of (Node) /= Empty_Node then
304	Print
305	(First_Declarative_Item_Of (Node), Indent + Increment);
306	Write_Empty_Line (Always => True);
307	end if;
308
309	when N_Declarative_Item =>
310	pragma Debug (Indicate_Tested (N_Declarative_Item));
311	Print (Current_Item_Node (Node), Indent);
312	Print (Next_Declarative_Item (Node), Indent);
313
314	when N_Package_Declaration =>
315	pragma Debug (Indicate_Tested (N_Package_Declaration));
316	Write_Empty_Line (Always => True);
317	Start_Line (Indent);
318	Write_String ("package ");
319	Output_Name (Name_Of (Node));
320
321	if Project_Of_Renamed_Package_Of (Node) /= Empty_Node then
322	Write_String (" renames ");
323	Output_Name
324	(Name_Of (Project_Of_Renamed_Package_Of (Node)));
325	Write_String (".");
326	Output_Name (Name_Of (Node));
327	Write_Line (";");
328
329	else
330	Write_Line (" is");
331
332	if First_Declarative_Item_Of (Node) /= Empty_Node then
333	Print
334	(First_Declarative_Item_Of (Node),
335	Indent + Increment);
336	end if;
337
338	Start_Line (Indent);
339	Write_String ("end ");
340	Output_Name (Name_Of (Node));
341	Write_Line (";");
342	Write_Empty_Line;
343	end if;
344
345	when N_String_Type_Declaration =>
346	pragma Debug (Indicate_Tested (N_String_Type_Declaration));
347	Start_Line (Indent);
348	Write_String ("type ");
349	Output_Name (Name_Of (Node));
350	Write_Line (" is");
351	Start_Line (Indent + Increment);
352	Write_String ("(");
353
354	declare
355	String_Node : Project_Node_Id :=
356	First_Literal_String (Node);
357
358	begin
359	while String_Node /= Empty_Node loop
360	Output_String (String_Value_Of (String_Node));
361	String_Node := Next_Literal_String (String_Node);
362
363	if String_Node /= Empty_Node then
364	Write_String (", ");
365	end if;
366	end loop;
367	end;
368
369	Write_Line (");");
370
371	when N_Literal_String =>
372	pragma Debug (Indicate_Tested (N_Literal_String));
373	Output_String (String_Value_Of (Node));
374
375	when N_Attribute_Declaration =>
376	pragma Debug (Indicate_Tested (N_Attribute_Declaration));
377	Start_Line (Indent);
378	Write_String ("for ");
379	Output_Name (Name_Of (Node));
380
381	if Associative_Array_Index_Of (Node) /= No_String then
382	Write_String (" (");
383	Output_String (Associative_Array_Index_Of (Node));
384	Write_String (")");
385	end if;
386
387	Write_String (" use ");
388	Print (Expression_Of (Node), Indent);
389	Write_Line (";");
390
391	when N_Typed_Variable_Declaration =>
392	pragma Debug
393	(Indicate_Tested (N_Typed_Variable_Declaration));
394	Start_Line (Indent);
395	Output_Name (Name_Of (Node));
396	Write_String (" : ");
397	Output_Name (Name_Of (String_Type_Of (Node)));
398	Write_String (" := ");
399	Print (Expression_Of (Node), Indent);
400	Write_Line (";");
401
402	when N_Variable_Declaration =>
403	pragma Debug (Indicate_Tested (N_Variable_Declaration));
404	Start_Line (Indent);
405	Output_Name (Name_Of (Node));
406	Write_String (" := ");
407	Print (Expression_Of (Node), Indent);
408	Write_Line (";");
409
410	when N_Expression =>
411	pragma Debug (Indicate_Tested (N_Expression));
412	declare
413	Term : Project_Node_Id := First_Term (Node);
414
415	begin
416	while Term /= Empty_Node loop
417	Print (Term, Indent);
418	Term := Next_Term (Term);
419
420	if Term /= Empty_Node then
421	Write_String (" & ");
422	end if;
423	end loop;
424	end;
425
426	when N_Term =>
427	pragma Debug (Indicate_Tested (N_Term));
428	Print (Current_Term (Node), Indent);
429
430	when N_Literal_String_List =>
431	pragma Debug (Indicate_Tested (N_Literal_String_List));
432	Write_String ("(");
433
434	declare
435	Expression : Project_Node_Id :=
436	First_Expression_In_List (Node);
437
438	begin
439	while Expression /= Empty_Node loop
440	Print (Expression, Indent);
441	Expression := Next_Expression_In_List (Expression);
442
443	if Expression /= Empty_Node then
444	Write_String (", ");
445	end if;
446	end loop;
447	end;
448
449	Write_String (")");
450
451	when N_Variable_Reference =>
452	pragma Debug (Indicate_Tested (N_Variable_Reference));
453	if Project_Node_Of (Node) /= Empty_Node then
454	Output_Name (Name_Of (Project_Node_Of (Node)));
455	Write_String (".");
456	end if;
457
458	if Package_Node_Of (Node) /= Empty_Node then
459	Output_Name (Name_Of (Package_Node_Of (Node)));
460	Write_String (".");
461	end if;
462
463	Output_Name (Name_Of (Node));
464
465	when N_External_Value =>
466	pragma Debug (Indicate_Tested (N_External_Value));
467	Write_String ("external (");
468	Print (External_Reference_Of (Node), Indent);
469
470	if External_Default_Of (Node) /= Empty_Node then
471	Write_String (", ");
472	Print (External_Default_Of (Node), Indent);
473	end if;
474
475	Write_String (")");
476
477	when N_Attribute_Reference =>
478	pragma Debug (Indicate_Tested (N_Attribute_Reference));
479
480	if Project_Node_Of (Node) /= Empty_Node
481	and then Project_Node_Of (Node) /= Project
482	then
483	Output_Name (Name_Of (Project_Node_Of (Node)));
484
485	if Package_Node_Of (Node) /= Empty_Node then
486	Write_String (".");
487	Output_Name (Name_Of (Package_Node_Of (Node)));
488	end if;
489
490	elsif Package_Node_Of (Node) /= Empty_Node then
491	Output_Name (Name_Of (Package_Node_Of (Node)));
492
493	else
494	Write_String ("project");
495	end if;
496
497	Write_String ("'");
498	Output_Name (Name_Of (Node));
499
500	declare
501	Index : constant String_Id :=
502	Associative_Array_Index_Of (Node);
503
504	begin
505	if Index /= No_String then
506	Write_String (" (");
507	Output_String (Index);
508	Write_String (")");
509	end if;
510	end;
511
512	when N_Case_Construction =>
513	pragma Debug (Indicate_Tested (N_Case_Construction));
514
515	declare
516	Case_Item : Project_Node_Id := First_Case_Item_Of (Node);
517	Is_Non_Empty : Boolean := False;
518	begin
519	while Case_Item /= Empty_Node loop
520	if First_Declarative_Item_Of (Case_Item) /= Empty_Node
521	or else not Eliminate_Empty_Case_Constructions
522	then
523	Is_Non_Empty := True;
524	exit;
525	end if;
526	Case_Item := Next_Case_Item (Case_Item);
527	end loop;
528
529	if Is_Non_Empty then
530	Write_Empty_Line;
531	Start_Line (Indent);
532	Write_String ("case ");
533	Print (Case_Variable_Reference_Of (Node), Indent);
534	Write_Line (" is");
535
536	declare
537	Case_Item : Project_Node_Id :=
538	First_Case_Item_Of (Node);
539
540	begin
541	while Case_Item /= Empty_Node loop
542	pragma Assert
543	(Kind_Of (Case_Item) = N_Case_Item);
544	Print (Case_Item, Indent + Increment);
545	Case_Item := Next_Case_Item (Case_Item);
546	end loop;
547	end;
548
549	Start_Line (Indent);
550	Write_Line ("end case;");
551	end if;
552	end;
553
554	when N_Case_Item =>
555	pragma Debug (Indicate_Tested (N_Case_Item));
556
557	if First_Declarative_Item_Of (Node) /= Empty_Node
558	or else not Eliminate_Empty_Case_Constructions
559	then
560	Write_Empty_Line;
561	Start_Line (Indent);
562	Write_String ("when ");
563
564	if First_Choice_Of (Node) = Empty_Node then
565	Write_String ("others");
566
567	else
568	declare
569	Label : Project_Node_Id := First_Choice_Of (Node);
570
571	begin
572	while Label /= Empty_Node loop
573	Print (Label, Indent);
574	Label := Next_Literal_String (Label);
575
576	if Label /= Empty_Node then
577	Write_String (" \| ");
578	end if;
579	end loop;
580	end;
581	end if;
582
583	Write_Line (" =>");
584
585	declare
586	First : Project_Node_Id :=
587	First_Declarative_Item_Of (Node);
588
589	begin
590	if First = Empty_Node then
591	Write_Eol.all;
592
593	else
594	Print (First, Indent + Increment);
595	end if;
596	end;
597	end if;
598	end case;
599	end if;
600	end Print;
601
602	begin
603	if W_Char = null then
604	Write_Char := Output.Write_Char'Access;
605	else
606	Write_Char := W_Char;
607	end if;
608
609	if W_Eol = null then
610	Write_Eol := Output.Write_Eol'Access;
611	else
612	Write_Eol := W_Eol;
613	end if;
614
615	if W_Str = null then
616	Write_Str := Output.Write_Str'Access;
617	else
618	Write_Str := W_Str;
619	end if;
620
621	Print (Project, 0);
622
623	if W_Char = null or else W_Str = null then
624	Output.Write_Eol;
625	end if;
626	end Pretty_Print;
627
628	-----------------------
629	-- Output_Statistics --
630	-----------------------
631
632	procedure Output_Statistics is
633	begin
634	Output.Write_Line ("Project_Node_Kinds not tested:");
635
636	for Kind in Project_Node_Kind loop
637	if Not_Tested (Kind) then
638	Output.Write_Str (" ");
639	Output.Write_Line (Project_Node_Kind'Image (Kind));
640	end if;
641	end loop;
642
643	Output.Write_Eol;
644	end Output_Statistics;
645
646	end Prj.PP;