| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- P R J . P P -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2001-2014, 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 Debug pragmas. |
| |
| --------------------- |
| -- 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_Project_File (S : Name_Id); |
| -- Output a project file name in one single string literal |
| |
| procedure Output_String (S : Name_Id; 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); |
| -- Needs comment??? |
| |
| 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_Project_File -- |
| ------------------------- |
| |
| procedure Output_Project_File (S : Name_Id) is |
| File_Name : constant String := Get_Name_String (S); |
| |
| begin |
| Write_Char ('"'); |
| |
| for J in File_Name'Range loop |
| if File_Name (J) = '"' then |
| Write_Char ('"'); |
| Write_Char ('"'); |
| else |
| Write_Char (File_Name (J)); |
| end if; |
| end loop; |
| |
| Write_Char ('"'); |
| end Output_Project_File; |
| |
| ------------------- |
| -- 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; |
| |
| ---------------- |
| -- 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 Abstract_Project => |
| 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_Project_File |
| (Name_Id (Extended_Project_Path_Of (Node, In_Tree))); |
| 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 the project name without concatenation, even if |
| -- the line is too long. |
| |
| Output_Project_File (String_Value_Of (Node, In_Tree)); |
| |
| 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; |
