Commit 3b8056a5 by Arnaud Charlet

[multiple changes]

2014-01-22  Ed Schonberg  <schonberg@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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  <dewar@adacore.com>

	* 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
parent fba9ebfc
2014-01-22 Ed Schonberg <schonberg@adacore.com>
* 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 <schonberg@adacore.com>
* 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 <dewar@adacore.com>
* 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 <quinot@adacore.com>
* rtsfind.adb: Update comment.
......
......@@ -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.
......
......@@ -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;
......
......@@ -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
......
......@@ -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;
......
......@@ -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
......
......@@ -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.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment