From 3b8056a559e3501d93ddf987cb5b20d2c6f9f188 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 22 Jan 2014 18:04:57 +0100 Subject: [PATCH] [multiple changes] 2014-01-22 Ed Schonberg * sem_ch6.adb (Analyze_Subprogram_Body_Helper): A subprogram body generated for an expression function within a protected body needs a set of renaming declarations if the expression function comes from source. 2014-01-22 Ed Schonberg * lib-xref.adb (Get_Type_Reference): In semantics-only mode, list interface progenitor of a tagged concurrent type, for better source navigation. 2014-01-22 Robert Dewar * lib.adb (In_Extended_Main_Code_Unit): Return False for Standard_Location. (In_Extended_Main_Source_Unit): Return False for Standard_Location. * lib.ads (In_Extended_Main_Code_Unit): Add documentation on treatment of Slocs No_Location and Standard_Location. * restrict.adb (Check_Restriction_No_Dependence): Explicitly check for entity with Standard_Location Sloc, rather than relying on Lib routines to do that. * sem_res.adb (Resolve_Call): Implement SPARK_05 restriction that a call cannot occur before a later occuring body within the same unit. From-SVN: r206931 --- gcc/ada/ChangeLog | 27 +++++++++++++++++++++++++++ gcc/ada/lib-xref.adb | 16 ++++++++++++++++ gcc/ada/lib.adb | 8 ++++---- gcc/ada/lib.ads | 8 ++++++++ gcc/ada/restrict.adb | 6 +++++- gcc/ada/sem_ch6.adb | 6 +++--- gcc/ada/sem_res.adb | 24 ++++++++++++++++++++++++ 7 files changed, 87 insertions(+), 8 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e8c2d2d6537..51f7ed64ba9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2014-01-22 Ed Schonberg + + * sem_ch6.adb (Analyze_Subprogram_Body_Helper): A subprogram + body generated for an expression function within a protected body + needs a set of renaming declarations if the expression function + comes from source. + +2014-01-22 Ed Schonberg + + * lib-xref.adb (Get_Type_Reference): In semantics-only mode, + list interface progenitor of a tagged concurrent type, for better + source navigation. + +2014-01-22 Robert Dewar + + * lib.adb (In_Extended_Main_Code_Unit): Return False for + Standard_Location. + (In_Extended_Main_Source_Unit): Return False for Standard_Location. + * lib.ads (In_Extended_Main_Code_Unit): Add documentation on + treatment of Slocs No_Location and Standard_Location. + * restrict.adb (Check_Restriction_No_Dependence): Explicitly + check for entity with Standard_Location Sloc, rather than relying + on Lib routines to do that. + * sem_res.adb (Resolve_Call): Implement SPARK_05 restriction + that a call cannot occur before a later occuring body within + the same unit. + 2014-01-22 Thomas Quinot * rtsfind.adb: Update comment. diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 14462ce93eb..409e736aee0 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1309,6 +1309,22 @@ package body Lib.Xref is Right := '>'; end if; + -- For a synchronized type that implements an interface, we + -- treat the first progenitor as the parent. This is only + -- needed when compiling a package declaration on its own, + -- if the body is present interfaces are handled properly. + + elsif Is_Concurrent_Type (Tref) + and then Is_Tagged_Type (Tref) + and then not Expander_Active + then + if Left /= '(' then + Left := '<'; + Right := '>'; + end if; + + Tref := Entity (First (Interface_List (Parent (Tref)))); + -- If the completion of a private type is itself a derived -- type, we need the parent of the full view. diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index b43ad986684..9ea496f3d26 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -718,7 +718,7 @@ package body Lib is is begin if Sloc (N) = Standard_Location then - return True; + return False; elsif Sloc (N) = No_Location then return False; @@ -750,7 +750,7 @@ package body Lib is function In_Extended_Main_Code_Unit (Loc : Source_Ptr) return Boolean is begin if Loc = Standard_Location then - return True; + return False; elsif Loc = No_Location then return False; @@ -787,7 +787,7 @@ package body Lib is -- Special value cases elsif Nloc = Standard_Location then - return True; + return False; elsif Nloc = No_Location then return False; @@ -826,7 +826,7 @@ package body Lib is -- Special value cases elsif Loc = Standard_Location then - return True; + return False; elsif Loc = No_Location then return False; diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index 00959cd2913..5c490cd2014 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -520,6 +520,14 @@ package Lib is -- instantiations are included in the extended main unit for this call. -- If the main unit is itself a subunit, then the extended main code unit -- includes its parent unit, and the parent unit spec if it is separate. + -- + -- This routine (and the following three routines) all return False if + -- Sloc (N) is No_Location or Standard_Location. In an earlier version, + -- they returned True for Standard_Location, but this was odd, and some + -- archeology indicated that this was done for the sole benefit of the + -- call in Restrict.Check_Restriction_No_Dependence, so we have moved + -- the special case check to that routine. This avoids some difficulties + -- with some other calls that malfunctioned with the odd return of True. function In_Extended_Main_Code_Unit (Loc : Source_Ptr) return Boolean; -- Same function as above, but argument is a source pointer rather diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index e244526389d..01c5f87a973 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -625,8 +625,12 @@ package body Restrict is begin -- Ignore call if node U is not in the main source unit. This avoids -- cascaded errors, e.g. when Ada.Containers units with other units. + -- However, allow Standard_Location here, since this catches some cases + -- of constructs that get converted to run-time calls. - if not In_Extended_Main_Source_Unit (U) then + if not In_Extended_Main_Source_Unit (U) + and then Sloc (U) /= Standard_Location + then return; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 9793aa4e188..62dd8898760 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -3218,13 +3218,13 @@ package body Sem_Ch6 is -- family index (if applicable). This form of early expansion is done -- when the Expander is active because Install_Private_Data_Declarations -- references entities which were created during regular expansion. The - -- body may be the rewritting of an expression function, and we need to - -- verify that the original node is in the source. + -- subprogram entity must come from source, and not be an internally + -- generated subprogram. if Expander_Active - and then Comes_From_Source (Original_Node (N)) and then Present (Prot_Typ) and then Present (Spec_Id) + and then Comes_From_Source (Spec_Id) and then not Is_Eliminated (Spec_Id) then Install_Private_Data_Declarations diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 9289971d0f8..537a6e166ae 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5468,6 +5468,30 @@ package body Sem_Res is end if; end if; + -- If the SPARK_05 restriction is active, we are not allowed + -- to have a call to a subprogram before we see its completion. + + if not Has_Completion (Nam) + and then Restriction_Check_Required (SPARK_05) + + -- Don't flag strange internal calls + + and then Comes_From_Source (N) + and then Comes_From_Source (Nam) + + -- Only flag calls in extended main source + + and then In_Extended_Main_Source_Unit (Nam) + and then In_Extended_Main_Source_Unit (N) + + -- Exclude enumeration literals from this processing + + and then Ekind (Nam) /= E_Enumeration_Literal + then + Check_SPARK_Restriction + ("call to subprogram cannot appear before its body", N); + end if; + -- Check that this is not a call to a protected procedure or entry from -- within a protected function.