-- --
-- B o d y --
-- --
--- --
--- Copyright (C) 2001-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2009, 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- --
+-- 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 COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- 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. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Characters.Handling; use Ada.Characters.Handling;
-with Hostparm;
-with Namet; use Namet;
-with Output; use Output;
-with Stringt; use Stringt;
+with Output; use Output;
+with Snames;
package body Prj.PP is
Not_Tested : array (Project_Node_Kind) of Boolean := (others => True);
- Max_Line_Length : constant := Hostparm.Max_Line_Length - 5;
- -- Maximum length of a line.
+ Max_Line_Length : constant := 255;
+ -- Maximum length of a line. This is chosen to be compatible with older
+ -- versions of GNAT that had a strict limit on the maximum line length.
Column : Natural := 0;
-- Column number of the last character in the line. Used to avoid
- -- outputing lines longer than Max_Line_Length.
+ -- 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".
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 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) is
-
+ W_Str : Write_Str_Ap := null;
+ Backward_Compatibility : Boolean;
+ Id : Prj.Project_Id := Prj.No_Project)
+ 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.
+ -- 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);
+ -- Outputs an attribute name, taking into account the value of
+ -- Backward_Compatibility.
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.
+ -- Outputs the indentation at the beginning of the line
- procedure Output_String (S : String_Id);
+ procedure Output_String (S : Name_Id);
+ procedure Output_String (S : Path_Name_Type);
-- 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.
+ -- 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);
+ procedure Write_String (S : String; Truncated : Boolean := False);
-- Outputs S using Write_Str, starting a new line if line would
- -- become too long.
+ -- 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 two access to procedure values are used for the output.
+ -- These three access to procedure values are used for the output
Last_Line_Is_Empty : Boolean := False;
- -- Used to avoid two consecutive empty lines.
+ -- Used to avoid two consecutive empty lines
+
+ ---------------------------
+ -- Output_Attribute_Name --
+ ---------------------------
+
+ procedure Output_Attribute_Name (Name : Name_Id) is
+ begin
+ if Backward_Compatibility then
+ case Name is
+ when Snames.Name_Spec =>
+ Output_Name (Snames.Name_Specification);
+
+ when Snames.Name_Spec_Suffix =>
+ Output_Name (Snames.Name_Specification_Suffix);
+
+ when Snames.Name_Body =>
+ Output_Name (Snames.Name_Implementation);
+
+ when Snames.Name_Body_Suffix =>
+ Output_Name (Snames.Name_Implementation_Suffix);
+
+ when others =>
+ Output_Name (Name);
+ end case;
+
+ else
+ Output_Name (Name);
+ end if;
+ end Output_Attribute_Name;
-----------------
-- Output_Name --
or else Is_Digit (Name_Buffer (J));
end if;
end loop;
+
+ Column := Column + Name_Len;
end Output_Name;
-------------------
-- Output_String --
-------------------
- procedure Output_String (S : String_Id) is
+ procedure Output_String (S : Name_Id) is
begin
- String_To_Name_Buffer (S);
+ Get_Name_String (S);
-- If line could become too long, create new line.
-- Note that the number of characters on the line could be
Write_Char ('"');
Column := Column + 1;
- String_To_Name_Buffer (S);
+ Get_Name_String (S);
for J in 1 .. Name_Len loop
if Name_Buffer (J) = '"' then
Column := Column + 1;
end Output_String;
+ procedure Output_String (S : Path_Name_Type) is
+ begin
+ Output_String (Name_Id (S));
+ end Output_String;
+
----------------
-- Start_Line --
----------------
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 (" --");
+ Write_String (Get_Name_String (Value), Truncated => True);
+ end if;
+
+ Write_Line ("");
+ end Write_End_Of_Line_Comment;
+
----------------
-- Write_Line --
----------------
-- Write_String --
------------------
- procedure Write_String (S : String) is
+ procedure Write_String (S : String; Truncated : Boolean := False) is
+ Length : Natural := S'Length;
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;
+ if Column + Length > Max_Line_Length then
+ if Truncated then
+ Length := Max_Line_Length - Column;
+
+ else
+ Write_Eol.all;
+ Column := 0;
+ end if;
end if;
- Write_Str (S);
- Column := Column + S'Length;
+ Write_Str (S (S'First .. S'First + Length - 1));
+ Column := Column + Length;
end Write_String;
-----------
procedure Print (Node : Project_Node_Id; Indent : Natural) is
begin
- if Node /= Empty_Node then
+ if Present (Node) then
- case Kind_Of (Node) is
+ case Kind_Of (Node, In_Tree) is
when N_Project =>
pragma Debug (Indicate_Tested (N_Project));
- if First_With_Clause_Of (Node) /= Empty_Node then
+ if Present (First_With_Clause_Of (Node, In_Tree)) then
-- with clause(s)
- Print (First_With_Clause_Of (Node), Indent);
+ 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);
Write_String ("project ");
- Output_Name (Name_Of (Node));
- -- Check if this project modifies another project
+ if Id /= Prj.No_Project then
+ Output_Name (Id.Display_Name);
+ else
+ Output_Name (Name_Of (Node, In_Tree));
+ end if;
+
+ -- Check if this project extends another project
- if Modified_Project_Path_Of (Node) /= No_String then
+ if Extended_Project_Path_Of (Node, In_Tree) /= No_Path then
Write_String (" extends ");
- Output_String (Modified_Project_Path_Of (Node));
+
+ if Is_Extending_All (Node, In_Tree) then
+ Write_String ("all ");
+ end if;
+
+ Output_String (Extended_Project_Path_Of (Node, In_Tree));
end if;
- Write_Line (" is");
+ Write_String (" is");
+ 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), Indent);
+ Print (Project_Declaration_Of (Node, In_Tree), Indent);
+ Print
+ (First_Comment_Before_End (Node, In_Tree),
+ Indent + Increment);
Start_Line (Indent);
Write_String ("end ");
- Output_Name (Name_Of (Node));
+
+ if Id /= Prj.No_Project then
+ Output_Name (Id.Display_Name);
+ else
+ Output_Name (Name_Of (Node, In_Tree));
+ end if;
+
Write_Line (";");
+ Print (First_Comment_After_End (Node, In_Tree), Indent);
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 (";");
+ -- 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 ");
+ end if;
+
+ Write_String ("with ");
+ end if;
+
+ Output_String (String_Value_Of (Node, In_Tree));
+
+ if Is_Not_Last_In_List (Node, In_Tree) then
+ Write_String (", ");
+ First_With_In_List := False;
+
+ else
+ Write_String (";");
+ 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), Indent);
+ Print (Next_With_Clause_Of (Node, In_Tree), Indent);
when N_Project_Declaration =>
pragma Debug (Indicate_Tested (N_Project_Declaration));
- if First_Declarative_Item_Of (Node) /= Empty_Node then
+ if
+ Present (First_Declarative_Item_Of (Node, In_Tree))
+ then
Print
- (First_Declarative_Item_Of (Node), Indent + Increment);
+ (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), Indent);
- Print (Next_Declarative_Item (Node), Indent);
+ 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 ");
- Output_Name (Name_Of (Node));
+ Output_Name (Name_Of (Node, In_Tree));
- if Project_Of_Renamed_Package_Of (Node) /= Empty_Node then
+ if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
+ Empty_Node
+ then
Write_String (" renames ");
Output_Name
- (Name_Of (Project_Of_Renamed_Package_Of (Node)));
+ (Name_Of
+ (Project_Of_Renamed_Package_Of (Node, In_Tree),
+ In_Tree));
Write_String (".");
- Output_Name (Name_Of (Node));
- Write_Line (";");
+ Output_Name (Name_Of (Node, In_Tree));
+ Write_String (";");
+ Write_End_Of_Line_Comment (Node);
+ Print (First_Comment_After_End (Node, In_Tree), Indent);
else
- Write_Line (" is");
-
- if First_Declarative_Item_Of (Node) /= Empty_Node then
+ Write_String (" is");
+ 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),
+ (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 ");
- Output_Name (Name_Of (Node));
+ Output_Name (Name_Of (Node, In_Tree));
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 ");
- Output_Name (Name_Of (Node));
+ Output_Name (Name_Of (Node, In_Tree));
Write_Line (" is");
Start_Line (Indent + Increment);
Write_String ("(");
declare
String_Node : Project_Node_Id :=
- First_Literal_String (Node);
+ First_Literal_String (Node, In_Tree);
begin
- while String_Node /= Empty_Node loop
- Output_String (String_Value_Of (String_Node));
- String_Node := Next_Literal_String (String_Node);
+ while Present (String_Node) loop
+ Output_String (String_Value_Of (String_Node, In_Tree));
+ String_Node :=
+ Next_Literal_String (String_Node, In_Tree);
- if String_Node /= Empty_Node then
+ if Present (String_Node) then
Write_String (", ");
end if;
end loop;
end;
- Write_Line (");");
+ Write_String (");");
+ 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));
+ Output_String (String_Value_Of (Node, In_Tree));
+
+ if Source_Index_Of (Node, In_Tree) /= 0 then
+ Write_String (" at");
+ Write_String (Source_Index_Of (Node, In_Tree)'Img);
+ 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 ");
- Output_Name (Name_Of (Node));
+ Output_Attribute_Name (Name_Of (Node, In_Tree));
- if Associative_Array_Index_Of (Node) /= No_String then
+ if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then
Write_String (" (");
- Output_String (Associative_Array_Index_Of (Node));
+ Output_String
+ (Associative_Array_Index_Of (Node, In_Tree));
Write_String (")");
end if;
Write_String (" use ");
- Print (Expression_Of (Node), Indent);
- Write_Line (";");
+
+ 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));
+
+ if
+ Present (Associative_Package_Of (Node, In_Tree))
+ then
+ Write_String (".");
+ Output_Name
+ (Name_Of
+ (Associative_Package_Of (Node, In_Tree),
+ In_Tree));
+ end if;
+
+ elsif
+ Present (Associative_Package_Of (Node, In_Tree))
+ then
+ Output_Name
+ (Name_Of
+ (Associative_Package_Of (Node, In_Tree),
+ In_Tree));
+ end if;
+
+ Write_String ("'");
+ Output_Attribute_Name (Name_Of (Node, In_Tree));
+ end if;
+
+ if Source_Index_Of (Node, In_Tree) /= 0 then
+ Write_String (" at");
+ Write_String (Source_Index_Of (Node, In_Tree)'Img);
+ end if;
+
+ Write_String (";");
+ 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));
+ Output_Name (Name_Of (Node, In_Tree));
Write_String (" : ");
- Output_Name (Name_Of (String_Type_Of (Node)));
+ Output_Name
+ (Name_Of (String_Type_Of (Node, In_Tree), In_Tree));
Write_String (" := ");
- Print (Expression_Of (Node), Indent);
- Write_Line (";");
+ Print (Expression_Of (Node, In_Tree), Indent);
+ Write_String (";");
+ 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));
+ Output_Name (Name_Of (Node, In_Tree));
Write_String (" := ");
- Print (Expression_Of (Node), Indent);
- Write_Line (";");
+ Print (Expression_Of (Node, In_Tree), Indent);
+ Write_String (";");
+ 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);
+ Term : Project_Node_Id := First_Term (Node, In_Tree);
begin
- while Term /= Empty_Node loop
+ while Present (Term) loop
Print (Term, Indent);
- Term := Next_Term (Term);
+ Term := Next_Term (Term, In_Tree);
- if Term /= Empty_Node then
+ if Present (Term) then
Write_String (" & ");
end if;
end loop;
when N_Term =>
pragma Debug (Indicate_Tested (N_Term));
- Print (Current_Term (Node), Indent);
+ Print (Current_Term (Node, In_Tree), Indent);
when N_Literal_String_List =>
pragma Debug (Indicate_Tested (N_Literal_String_List));
declare
Expression : Project_Node_Id :=
- First_Expression_In_List (Node);
+ First_Expression_In_List (Node, In_Tree);
begin
- while Expression /= Empty_Node loop
+ while Present (Expression) loop
Print (Expression, Indent);
- Expression := Next_Expression_In_List (Expression);
+ Expression :=
+ Next_Expression_In_List (Expression, In_Tree);
- if Expression /= Empty_Node then
+ if Present (Expression) then
Write_String (", ");
end if;
end loop;
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)));
+ if Present (Project_Node_Of (Node, In_Tree)) then
+ Output_Name
+ (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
Write_String (".");
end if;
- if Package_Node_Of (Node) /= Empty_Node then
- Output_Name (Name_Of (Package_Node_Of (Node)));
+ if Present (Package_Node_Of (Node, In_Tree)) then
+ Output_Name
+ (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
Write_String (".");
end if;
- Output_Name (Name_Of (Node));
+ Output_Name (Name_Of (Node, In_Tree));
when N_External_Value =>
pragma Debug (Indicate_Tested (N_External_Value));
Write_String ("external (");
- Print (External_Reference_Of (Node), Indent);
+ Print (External_Reference_Of (Node, In_Tree), Indent);
- if External_Default_Of (Node) /= Empty_Node then
+ if Present (External_Default_Of (Node, In_Tree)) then
Write_String (", ");
- Print (External_Default_Of (Node), Indent);
+ Print (External_Default_Of (Node, In_Tree), 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
+ 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)));
+ Output_Name
+ (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
- if Package_Node_Of (Node) /= Empty_Node then
+ if Present (Package_Node_Of (Node, In_Tree)) then
Write_String (".");
- Output_Name (Name_Of (Package_Node_Of (Node)));
+ Output_Name
+ (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
end if;
- elsif Package_Node_Of (Node) /= Empty_Node then
- Output_Name (Name_Of (Package_Node_Of (Node)));
+ elsif Present (Package_Node_Of (Node, In_Tree)) then
+ Output_Name
+ (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
else
Write_String ("project");
end if;
Write_String ("'");
- Output_Name (Name_Of (Node));
+ Output_Attribute_Name (Name_Of (Node, In_Tree));
declare
- Index : constant String_Id :=
- Associative_Array_Index_Of (Node);
+ Index : constant Name_Id :=
+ Associative_Array_Index_Of (Node, In_Tree);
begin
- if Index /= No_String then
+ if Index /= No_Name then
Write_String (" (");
Output_String (Index);
Write_String (")");
pragma Debug (Indicate_Tested (N_Case_Construction));
declare
- Case_Item : Project_Node_Id := First_Case_Item_Of (Node);
+ Case_Item : Project_Node_Id;
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
+ 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);
+
+ 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 ");
- Print (Case_Variable_Reference_Of (Node), Indent);
- Write_Line (" is");
+ Print
+ (Case_Variable_Reference_Of (Node, In_Tree),
+ Indent);
+ Write_String (" is");
+ 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);
-
+ First_Case_Item_Of (Node, In_Tree);
begin
- while Case_Item /= Empty_Node loop
+ while Present (Case_Item) loop
pragma Assert
- (Kind_Of (Case_Item) = N_Case_Item);
+ (Kind_Of (Case_Item, In_Tree) = N_Case_Item);
Print (Case_Item, Indent + Increment);
- Case_Item := Next_Case_Item (Case_Item);
+ 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 First_Declarative_Item_Of (Node) /= Empty_Node
+ 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 ");
- if First_Choice_Of (Node) = Empty_Node then
+ if No (First_Choice_Of (Node, In_Tree)) then
Write_String ("others");
else
declare
- Label : Project_Node_Id := First_Choice_Of (Node);
-
+ Label : Project_Node_Id :=
+ First_Choice_Of (Node, In_Tree);
begin
- while Label /= Empty_Node loop
+ while Present (Label) loop
Print (Label, Indent);
- Label := Next_Literal_String (Label);
+ Label := Next_Literal_String (Label, In_Tree);
- if Label /= Empty_Node then
+ if Present (Label) then
Write_String (" | ");
end if;
end loop;
end;
end if;
- Write_Line (" =>");
+ Write_String (" =>");
+ Write_End_Of_Line_Comment (Node);
+ Print
+ (First_Comment_After (Node, In_Tree),
+ Indent + Increment);
declare
- First : Project_Node_Id :=
- First_Declarative_Item_Of (Node);
-
+ First : constant Project_Node_Id :=
+ First_Declarative_Item_Of (Node, In_Tree);
begin
- if First = Empty_Node then
- Write_Eol.all;
-
+ 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 ("--");
+ Write_String
+ (Get_Name_String (String_Value_Of (Node, In_Tree)),
+ 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;
Output.Write_Line ("Project_Node_Kinds not tested:");
for Kind in Project_Node_Kind loop
- if Not_Tested (Kind) then
+ if Kind /= N_Comment_Zones and then Not_Tested (Kind) then
Output.Write_Str (" ");
Output.Write_Line (Project_Node_Kind'Image (Kind));
end if;
OSDN Git Service
