summaryrefslogtreecommitdiff
path: root/gcc/ada/prj-pp.adb
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2003-12-08 10:33:17 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2003-12-08 10:33:17 +0000
commitbdd64cbef403677f46362009e2b592176d04d22d (patch)
treec83150f858a1ea22febff15880c94d93b7c3314f /gcc/ada/prj-pp.adb
parent75213f6909b7f4c460932a1ec9b29b575627818d (diff)
downloadgcc-bdd64cbef403677f46362009e2b592176d04d22d.tar.gz
2003-12-08 Jerome Guitton <guitton@act-europe.fr>
* 5ytiitho.adb, 5zthrini.adb, 5ztiitho.adb, i-vthrea.adb, i-vthrea.ads, s-tpae65.adb, s-tpae65.ads: Cleanup: Remove a bunch of obsolete files. * Makefile.in: (rts-ravenscar): Generate an empty libgnat.a. (rts-zfp): Ditto. 2003-12-08 Robert Dewar <dewar@gnat.com> * 7sintman.adb: Minor reformatting * bindgen.adb: Configurable_Run_Time mode no longer suppresses the standard linker options to get standard libraries linked. We now plan to provide dummy versions of these libraries to match the appropriate configurable run-time (e.g. if a library is not needed at all, provide a dummy empty library). * targparm.ads: Configurable_Run_Time mode no longer affects linker options (-L parameters and standard libraries). What we plan to do is to provide dummy libraries where the libraries are not required. * gnatbind.adb: Minor comment improvement 2003-12-08 Javier Miranda <miranda@gnat.com> * exp_aggr.adb (Build_Record_Aggr_Code): Do not remove the expanded aggregate in the parent. Otherwise constants with limited aggregates are not supported. Add new formal to pass the component type (Ctype). It is required to call the corresponding IP subprogram in case of default initialized components. (Gen_Assign): In case of default-initialized component, generate a call to the IP subprogram associated with the component. (Build_Record_Aggr_Code): Remove the aggregate from the parent in case of aggregate with default initialized components. (Has_Default_Init_Comps): Improve implementation to recursively check all the present expressions. * exp_ch3.ads, exp_ch3.adb (Build_Initialization_Call): Add new formal to indicate that the initialization call corresponds to a default-initialized component of an aggregate. In case of default initialized aggregate with tasks this parameter is used to generate a null string (this is just a workaround that must be improved later). In case of discriminants, this parameter is used to generate a selected component node that gives access to the discriminant value. * exp_ch9.ads, exp_ch9.adb (Build_Task_Allocate_Block_With_Stmts): New subprogram, based on Build_Task_Allocate_Block, but adapted to expand allocated aggregates with default-initialized components. * par-ch4.adb (P_Aggregate_Or_Paren_Expr): Improve error message if the box notation is used in positional aggregates. 2003-12-08 Samuel Tardieu <tardieu@act-europe.fr> * lib.ads: Fix typo in comment 2003-12-08 Vincent Celier <celier@gnat.com> * prj.adb (Project_Empty): New component Unkept_Comments (Scan): Remove procedure; moved to Prj.Err. * prj.ads (Project_Data): New Boolean component Unkept_Comments (Scan): Remove procedure; moved to Prj.Err. * prj-dect.adb: Manage comments for the different declarations. * prj-part.adb (With_Record): New component Node (Parse): New Boolean parameter Store_Comments, defaulted to False. Set the scanner to return ends of line and comments as tokens, if Store_Comments is True. (Pre_Parse_Context_Clause): Create the N_With_Clause nodes so that comments are associated with these nodes. Store the node IDs in the With_Records. (Post_Parse_Context_Clause): Use the N_With_Clause nodes stored in the With_Records. (Parse_Single_Project): Call Pre_Parse_Context_Clause before creating the N_Project node. Call Tree.Save and Tree.Reset before scanning the current project. Call Tree.Restore afterwards. Set the various nodes for comment storage (Next_End, End_Of_Line, Previous_Line, Previous_End). * prj-part.ads (Parse): New Boolean parameter Store_Comments, defaulted to False. * prj-pp.adb (Write_String): New Boolean parameter Truncated, defaulted to False. When Truncated is True, truncate the string, never go to the next line. (Write_End_Of_Line_Comment): New procedure (Print): Process comments for nodes N_With_Clause, N_Package_Declaration, N_String_Type_Declaration, N_Attribute_Declaration, N_Typed_Variable_Declaration, N_Variable_Declaration, N_Case_Construction, N_Case_Item. Process nodes N_Comment. * prj-tree.ads, prj-tree.adb (Default_Project_Node): If it is a node without comments and there are some comments, set the flag Unkept_Comments to True. (Scan): If there are comments, set the flag Unkept_Comments to True and clear the comments. (Project_Node_Kind): Add enum values N_Comment_Zones, N_Comment (Next_End_Nodes: New table (Comment_Zones_Of): New function (Scan): New procedure; moved from Prj. Accumulate comments in the Comments table and set end of line comments, comments after, after end and before end. (Add_Comments): New procedure (Save, Restore, Seset_State): New procedures (There_Are_Unkept_Comments): New function (Set_Previous_Line_Node, Set_Previous_End_Node): New procedures (Set_End_Of_Line, Set_Next_End_Node, Remove_Next_End_Node): New procedures. (First_Comment_After, First_Comment_After_End): New functions (First_Comment_Before, First_Comment_Before_End): New functions (Next_Comment): New function (End_Of_Line_Comment, Follows_Empty_Line, Is_Followed_By_Empty_Line): New functions (Set_First_Comment_After, Set_First_Comment_After_End): New procedures (Set_First_Comment_Before, Set_First_Comment_Before_End): New procedures (Set_Next_Comment): New procedure (Default_Project_Node): Associate comment before if the node can store comments. * scans.ads (Token_Type): New enumeration value Tok_Comment (Comment_Id): New global variable * scng.ads, scng.adb (Comment_Is_Token): New Boolean global variable, defaulted to False. (Scan): Store position of start of comment. If comments are tokens, set Comment_Id and set Token to Tok_Comment when scanning a comment. (Set_Comment_As_Token): New procedure * sinput-p.adb: Update Copyright notice (Source_File_Is_Subunit): Call Prj.Err.Scanner.Scan instead of Prj.Scan that no longer exists. 2003-12-08 Javier Miranda <miranda@gnat.com> * sem_aggr.adb: Add dependence on Exp_Tss package Correct typo in comment (Resolve_Aggregate): In case of array aggregates set the estimated type of the aggregate before calling resolve. This is needed to know the name of the corresponding IP in case of limited array aggregates. (Resolve_Array_Aggregate): Delay the resolution to the expansion phase in case of default initialized array components. * sem_ch12.adb (Analyze_Formal_Object_Declaration): Allow limited types. Required to give support to limited aggregates in generic formals. 2003-12-08 Ed Schonberg <schonberg@gnat.com> * sem_ch3.adb (Check_Initialization): For legality purposes, an inlined body functions like an instantiation. (Decimal_Fixed_Point_Declaration): Do not set kind of first subtype until bounds are analyzed, to diagnose premature use of type. * sem_util.adb (Wrong_Type): Improve error message when the type of the expression is used prematurely. 2003-12-08 GNAT Script <nobody@gnat.com> * Make-lang.in: Makefile automatically updated git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@74414 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/prj-pp.adb')
-rw-r--r--gcc/ada/prj-pp.adb133
1 files changed, 110 insertions, 23 deletions
diff --git a/gcc/ada/prj-pp.adb b/gcc/ada/prj-pp.adb
index 8bbc265efc8..1ac45ed28e3 100644
--- a/gcc/ada/prj-pp.adb
+++ b/gcc/ada/prj-pp.adb
@@ -27,8 +27,8 @@
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Hostparm;
-with Namet; use Namet;
-with Output; use Output;
+with Namet; use Namet;
+with Output; use Output;
with Snames;
package body Prj.PP is
@@ -47,7 +47,6 @@ package body Prj.PP is
procedure Indicate_Tested (Kind : Project_Node_Kind);
-- Set the corresponding component of array Not_Tested to False.
-- Only called by pragmas Debug.
- --
---------------------
-- Indicate_Tested --
@@ -98,9 +97,13 @@ package body Prj.PP is
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;
@@ -246,6 +249,21 @@ package body Prj.PP is
end if;
end Write_Empty_Line;
+ -------------------------------
+ -- Write_End_Of_Line_Comment --
+ -------------------------------
+
+ procedure Write_End_Of_Line_Comment (Node : Project_Node_Id) is
+ Value : Name_Id := End_Of_Line_Comment (Node);
+ 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 --
----------------
@@ -262,18 +280,24 @@ package body Prj.PP is
-- 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;
-----------
@@ -296,6 +320,7 @@ package body Prj.PP is
Write_Empty_Line (Always => True);
end if;
+ Print (First_Comment_Before (Node), Indent);
Start_Line (Indent);
Write_String ("project ");
Output_Name (Name_Of (Node));
@@ -307,21 +332,26 @@ package body Prj.PP is
Output_String (Extended_Project_Path_Of (Node));
end if;
- Write_Line (" is");
+ Write_String (" is");
+ Write_End_Of_Line_Comment (Node);
+ Print (First_Comment_After (Node), Indent + Increment);
Write_Empty_Line (Always => True);
-- Output all of the declarations in the project
Print (Project_Declaration_Of (Node), Indent);
+ Print (First_Comment_Before_End (Node), Indent + Increment);
Start_Line (Indent);
Write_String ("end ");
Output_Name (Name_Of (Node));
Write_Line (";");
+ Print (First_Comment_After_End (Node), Indent);
when N_With_Clause =>
pragma Debug (Indicate_Tested (N_With_Clause));
if Name_Of (Node) /= No_Name then
+ Print (First_Comment_Before (Node), Indent);
Start_Line (Indent);
if Non_Limited_Project_Node_Of (Node) = Empty_Node then
@@ -330,7 +360,9 @@ package body Prj.PP is
Write_String ("with ");
Output_String (String_Value_Of (Node));
- Write_Line (";");
+ Write_String (";");
+ Write_End_Of_Line_Comment (Node);
+ Print (First_Comment_After (Node), Indent);
end if;
Print (Next_With_Clause_Of (Node), Indent);
@@ -352,6 +384,7 @@ package body Prj.PP is
when N_Package_Declaration =>
pragma Debug (Indicate_Tested (N_Package_Declaration));
Write_Empty_Line (Always => True);
+ Print (First_Comment_Before (Node), Indent);
Start_Line (Indent);
Write_String ("package ");
Output_Name (Name_Of (Node));
@@ -362,10 +395,14 @@ package body Prj.PP is
(Name_Of (Project_Of_Renamed_Package_Of (Node)));
Write_String (".");
Output_Name (Name_Of (Node));
- Write_Line (";");
+ Write_String (";");
+ Write_End_Of_Line_Comment (Node);
+ Print (First_Comment_After_End (Node), Indent);
else
- Write_Line (" is");
+ Write_String (" is");
+ Write_End_Of_Line_Comment (Node);
+ Print (First_Comment_After (Node), Indent + Increment);
if First_Declarative_Item_Of (Node) /= Empty_Node then
Print
@@ -373,15 +410,19 @@ package body Prj.PP is
Indent + Increment);
end if;
+ Print (First_Comment_Before_End (Node),
+ Indent + Increment);
Start_Line (Indent);
Write_String ("end ");
Output_Name (Name_Of (Node));
Write_Line (";");
+ Print (First_Comment_After_End (Node), Indent);
Write_Empty_Line;
end if;
when N_String_Type_Declaration =>
pragma Debug (Indicate_Tested (N_String_Type_Declaration));
+ Print (First_Comment_Before (Node), Indent);
Start_Line (Indent);
Write_String ("type ");
Output_Name (Name_Of (Node));
@@ -404,7 +445,9 @@ package body Prj.PP is
end loop;
end;
- Write_Line (");");
+ Write_String (");");
+ Write_End_Of_Line_Comment (Node);
+ Print (First_Comment_After (Node), Indent);
when N_Literal_String =>
pragma Debug (Indicate_Tested (N_Literal_String));
@@ -412,6 +455,7 @@ package body Prj.PP is
when N_Attribute_Declaration =>
pragma Debug (Indicate_Tested (N_Attribute_Declaration));
+ Print (First_Comment_Before (Node), Indent);
Start_Line (Indent);
Write_String ("for ");
Output_Attribute_Name (Name_Of (Node));
@@ -424,26 +468,34 @@ package body Prj.PP is
Write_String (" use ");
Print (Expression_Of (Node), Indent);
- Write_Line (";");
+ Write_String (";");
+ Write_End_Of_Line_Comment (Node);
+ Print (First_Comment_After (Node), Indent);
when N_Typed_Variable_Declaration =>
pragma Debug
(Indicate_Tested (N_Typed_Variable_Declaration));
+ Print (First_Comment_Before (Node), Indent);
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 (";");
+ Write_String (";");
+ Write_End_Of_Line_Comment (Node);
+ Print (First_Comment_After (Node), Indent);
when N_Variable_Declaration =>
pragma Debug (Indicate_Tested (N_Variable_Declaration));
+ Print (First_Comment_Before (Node), Indent);
Start_Line (Indent);
Output_Name (Name_Of (Node));
Write_String (" := ");
Print (Expression_Of (Node), Indent);
- Write_Line (";");
+ Write_String (";");
+ Write_End_Of_Line_Comment (Node);
+ Print (First_Comment_After (Node), Indent);
when N_Expression =>
pragma Debug (Indicate_Tested (N_Expression));
@@ -566,10 +618,13 @@ package body Prj.PP is
if Is_Non_Empty then
Write_Empty_Line;
+ Print (First_Comment_Before (Node), Indent);
Start_Line (Indent);
Write_String ("case ");
Print (Case_Variable_Reference_Of (Node), Indent);
- Write_Line (" is");
+ Write_String (" is");
+ Write_End_Of_Line_Comment (Node);
+ Print (First_Comment_After (Node), Indent + Increment);
declare
Case_Item : Project_Node_Id :=
@@ -584,8 +639,11 @@ package body Prj.PP is
end loop;
end;
+ Print (First_Comment_Before_End (Node),
+ Indent + Increment);
Start_Line (Indent);
Write_Line ("end case;");
+ Print (First_Comment_After_End (Node), Indent);
end if;
end;
@@ -596,6 +654,7 @@ package body Prj.PP is
or else not Eliminate_Empty_Case_Constructions
then
Write_Empty_Line;
+ Print (First_Comment_Before (Node), Indent);
Start_Line (Indent);
Write_String ("when ");
@@ -618,7 +677,9 @@ package body Prj.PP is
end;
end if;
- Write_Line (" =>");
+ Write_String (" =>");
+ Write_End_Of_Line_Comment (Node);
+ Print (First_Comment_After (Node), Indent + Increment);
declare
First : constant Project_Node_Id :=
@@ -626,13 +687,39 @@ package body Prj.PP is
begin
if First = Empty_Node then
- Write_Eol.all;
+ 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) then
+ Write_Empty_Line;
+ end if;
+
+ Start_Line (Indent);
+ Write_String ("--");
+ Write_String
+ (Get_Name_String (String_Value_Of (Node)),
+ Truncated => True);
+ Write_Line ("");
+
+ if Is_Followed_By_Empty_Line (Node) then
+ Write_Empty_Line;
+ end if;
+
+ Print (Next_Comment (Node), Indent);
end case;
end if;
end Print;
@@ -674,7 +761,7 @@ package body Prj.PP is
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;