From 1933c4977eeaa926e06ee032f0335a2abf53958a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 29 Apr 2009 15:56:09 +0200 Subject: [PATCH] [multiple changes] 2009-04-29 Gary Dismukes * sem_aggr.adb (Valid_Limited_Ancestor): Add test for the name of a function entity, to cover the case of a parameterless function call that has not been resolved. 2009-04-29 Robert Dewar * err_vars.ads, prj-part.adb, scans.ads, exp_tss.adb: Minor reformatting and comment updates. From-SVN: r146970 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/err_vars.ads | 16 ++++++++++------ gcc/ada/exp_tss.adb | 8 ++++---- gcc/ada/prj-part.adb | 7 +++++++ gcc/ada/scans.ads | 28 ++++++++++++++++------------ gcc/ada/sem_aggr.adb | 8 ++++++++ 6 files changed, 56 insertions(+), 22 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 553edf2d643..38819f6a8b3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2009-04-29 Gary Dismukes + + * sem_aggr.adb (Valid_Limited_Ancestor): Add test for the name of a + function entity, to cover the case of a parameterless function call + that has not been resolved. + +2009-04-29 Robert Dewar + + * err_vars.ads, prj-part.adb, scans.ads, exp_tss.adb: Minor + reformatting and comment updates. + 2009-04-29 Arnaud Charlet * gnat_ugn.texi: Update some documentation about interfacing with C++ diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index 1ec6e3dd1c6..c4c28dafc36 100644 --- a/gcc/ada/err_vars.ads +++ b/gcc/ada/err_vars.ads @@ -32,9 +32,11 @@ with Uintp; use Uintp; package Err_Vars is - -- Some variables are initialized so that some tools (such as gprbuild) - -- can be built with -gnatVa and pragma Initialized_Scalars without - -- problems. + -- All of these variables are set when needed, so they do not need to be + -- initialized. However, there is code that saves and restores existing + -- values, which may malfunction in -gnatVa mode if the variable has never + -- been iniitalized, so we initialize some variables to avoid exceptions + -- from invalid values in such cases. ------------------ -- Error Counts -- @@ -44,16 +46,17 @@ package Err_Vars is -- This is a count of errors that are serious enough to stop expansion, -- and hence to prevent generation of an object file even if the -- switch -gnatQ is set. Initialized to zero at the start of compilation. + -- Initialized for -gnatVa use, see comment above. Total_Errors_Detected : Nat := 0; -- Number of errors detected so far. Includes count of serious errors and -- non-serious errors, so this value is always greater than or equal to the -- Serious_Errors_Detected value. Initialized to zero at the start of - -- compilation. + -- compilation. Initialized for -gnatVa use, see comment above. Warnings_Detected : Nat := 0; -- Number of warnings detected. Initialized to zero at the start of - -- compilation. + -- compilation. Initialized for -gnatVa use, see comment above. ---------------------------------- -- Error Message Mode Variables -- @@ -71,7 +74,7 @@ package Err_Vars is -- note get reset by any Error_Msg call, so the caller is responsible -- for resetting it. - Warn_On_Instance : Boolean; + Warn_On_Instance : Boolean := False; -- Normally if a warning is generated in a generic template from the -- analysis of the template, then the warning really belongs in the -- template, and the default value of False for this Boolean achieves @@ -86,6 +89,7 @@ package Err_Vars is -- resulting from illegalities, and also for substitution of more -- appropriate error messages from higher semantic levels. It is -- a counter so that the increment/decrement protocol nests neatly. + -- Initialized for -gnatVa use, see comment above. Error_Msg_Exception : exception; -- Exception raised if Raise_Exception_On_Error is true diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb index c7e03660d94..902d4e7b593 100644 --- a/gcc/ada/exp_tss.adb +++ b/gcc/ada/exp_tss.adb @@ -216,9 +216,10 @@ package body Exp_Tss is -- default constructor and hence we must skip non-default -- constructors (if any) - elsif No (Next - (First - (Parameter_Specifications (Parent (Node (Elmt)))))) + elsif + No (Next + (First + (Parameter_Specifications (Parent (Node (Elmt)))))) then return Node (Elmt); end if; @@ -240,7 +241,6 @@ package body Exp_Tss is if Is_Init_Proc (Node (Elmt)) then E1 := Next_Formal (First_Formal (Node (Elmt))); E2 := First_Formal (Ref); - while Present (E1) and then Present (E2) loop if Chars (E1) /= Chars (E2) or else Ekind (E1) /= Ekind (E2) diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index afc546fd3e0..0608e028d20 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -1099,6 +1099,13 @@ package body Prj.Part is A_Project_Name_And_Node.Node; begin + -- Loop through extending projects to find the ultimate + -- extending project, that is the one that is not + -- extended. But don't attempt to find an extending + -- project if the initial project is an abstract project, + -- as it may have been extended several time, so it + -- cannot have a single extending project. + while Extending_Project_Of (Decl, In_Tree) /= Empty_Node loop diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads index fbdc5cee41d..6f9bcb8c727 100644 --- a/gcc/ada/scans.ads +++ b/gcc/ada/scans.ads @@ -344,40 +344,44 @@ package Scans is -- Note: these variables can only be referenced during the parsing of a -- file. Reference to any of them from Sem or the expander is wrong. - -- Some of these variables are initialized so that some tools (such as - -- gprbuild) can be built with -gnatVa and pragma Initialized_Scalars - -- without problems. - Scan_Ptr : Source_Ptr := No_Location; + -- These variables are initialized as required by Scn.Initialize_Scanner, + -- and should not be referenced before such a call. However, there are + -- situations in which these variables are saved and restored, and this + -- may happen before the first Initialize_Scanner call, resulting in the + -- assignment of invalid values. To avoid this, and allow building with + -- the -gnatVa switch, we initialize some variables to known valid values. + + Scan_Ptr : Source_Ptr := No_Location; -- init for -gnatVa -- Current scan pointer location. After a call to Scan, this points -- just past the end of the token just scanned. - Token : Token_Type := No_Token; + Token : Token_Type := No_Token; -- init for -gnatVa -- Type of current token - Token_Ptr : Source_Ptr := No_Location; + Token_Ptr : Source_Ptr := No_Location; -- init for -gnatVa -- Pointer to first character of current token - Current_Line_Start : Source_Ptr := No_Location; - -- Pointer to first character of line containing current token + Current_Line_Start : Source_Ptr := No_Location; -- init for -gnatVa + -- Pointer to first character of line containing current token. - Start_Column : Column_Number := No_Column_Number; + Start_Column : Column_Number := No_Column_Number; -- init for -gnatVa -- Starting column number (zero origin) of the first non-blank character -- on the line containing the current token. This is used for error -- recovery circuits which depend on looking at the column line up. - Type_Token_Location : Source_Ptr := No_Location; + Type_Token_Location : Source_Ptr := No_Location; -- init for -gnatVa -- Within a type declaration, gives the location of the TYPE keyword that -- opened the type declaration. Used in checking the end column of a record -- declaration, which can line up either with the TYPE keyword, or with the -- start of the line containing the RECORD keyword. - Checksum : Word := 0; + Checksum : Word := 0; -- init for -gnatVa -- Used to accumulate a CRC representing the tokens in the source -- file being compiled. This CRC includes only program tokens, and -- excludes comments. - First_Non_Blank_Location : Source_Ptr := No_Location; + First_Non_Blank_Location : Source_Ptr := No_Location; -- init for -gnatVa -- Location of first non-blank character on the line containing the -- current token (i.e. the location of the character whose column number -- is stored in Start_Column). diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index e7cb9cc1651..e5d8cdc5e1f 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -2147,6 +2147,14 @@ package body Sem_Aggr is elsif Nkind_In (Anc, N_Aggregate, N_Function_Call) then return True; + -- Check for a function name, to cover the case of a parameterless + -- function call which hasn't been resolved yet. + + elsif Is_Entity_Name (Anc) + and then Ekind (Entity (Anc)) = E_Function + then + return True; + elsif Nkind (Anc) = N_Attribute_Reference and then Attribute_Name (Anc) = Name_Input then