diff options
Diffstat (limited to 'gcc/ada/prj-pp.adb')
| -rw-r--r-- | gcc/ada/prj-pp.adb | 97 |
1 files changed, 69 insertions, 28 deletions
diff --git a/gcc/ada/prj-pp.adb b/gcc/ada/prj-pp.adb index 91580e4ae84..8bbc265efc8 100644 --- a/gcc/ada/prj-pp.adb +++ b/gcc/ada/prj-pp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2003 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- -- @@ -29,7 +29,7 @@ with Ada.Characters.Handling; use Ada.Characters.Handling; with Hostparm; with Namet; use Namet; with Output; use Output; -with Stringt; use Stringt; +with Snames; package body Prj.PP is @@ -42,7 +42,7 @@ package body Prj.PP is Column : Natural := 0; -- Column number of the last character in the line. Used to avoid - -- outputting lines longer than Max_Line_Length. + -- outputing lines longer than Max_Line_Length. procedure Indicate_Tested (Kind : Project_Node_Kind); -- Set the corresponding component of array Not_Tested to False. @@ -69,14 +69,18 @@ package body Prj.PP is 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) + 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 @@ -84,13 +88,12 @@ package body Prj.PP is procedure Start_Line (Indent : Natural); -- Outputs the indentation at the beginning of the line. - procedure Output_String (S : String_Id); + procedure Output_String (S : Name_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. + -- 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 @@ -102,11 +105,40 @@ package body Prj.PP is 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. + --------------------------- + -- 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 -- ----------------- @@ -137,15 +169,17 @@ package body Prj.PP is 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 @@ -159,7 +193,7 @@ package body Prj.PP is 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 @@ -266,11 +300,11 @@ package body Prj.PP is Write_String ("project "); Output_Name (Name_Of (Node)); - -- Check if this project modifies another project + -- Check if this project extends another project - if Modified_Project_Path_Of (Node) /= No_String then + if Extended_Project_Path_Of (Node) /= No_Name then Write_String (" extends "); - Output_String (Modified_Project_Path_Of (Node)); + Output_String (Extended_Project_Path_Of (Node)); end if; Write_Line (" is"); @@ -289,6 +323,11 @@ package body Prj.PP is if Name_Of (Node) /= No_Name then Start_Line (Indent); + + if Non_Limited_Project_Node_Of (Node) = Empty_Node then + Write_String ("limited "); + end if; + Write_String ("with "); Output_String (String_Value_Of (Node)); Write_Line (";"); @@ -375,9 +414,9 @@ package body Prj.PP is pragma Debug (Indicate_Tested (N_Attribute_Declaration)); Start_Line (Indent); Write_String ("for "); - Output_Name (Name_Of (Node)); + Output_Attribute_Name (Name_Of (Node)); - if Associative_Array_Index_Of (Node) /= No_String then + if Associative_Array_Index_Of (Node) /= No_Name then Write_String (" ("); Output_String (Associative_Array_Index_Of (Node)); Write_String (")"); @@ -494,14 +533,14 @@ package body Prj.PP is end if; Write_String ("'"); - Output_Name (Name_Of (Node)); + Output_Attribute_Name (Name_Of (Node)); declare - Index : constant String_Id := + Index : constant Name_Id := Associative_Array_Index_Of (Node); begin - if Index /= No_String then + if Index /= No_Name then Write_String (" ("); Output_String (Index); Write_String (")"); @@ -582,8 +621,8 @@ package body Prj.PP is Write_Line (" =>"); declare - First : Project_Node_Id := - First_Declarative_Item_Of (Node); + First : constant Project_Node_Id := + First_Declarative_Item_Of (Node); begin if First = Empty_Node then @@ -598,6 +637,8 @@ package body Prj.PP is end if; end Print; + -- Start of processing for Pretty_Print + begin if W_Char = null then Write_Char := Output.Write_Char'Access; |