Commit 66dc8075 by Arnaud Charlet

[multiple changes]

2011-09-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function): If the expression
	function comes from source, indicate that so does its rewriting,
	so it is compatible with any subsequent expansion of the
	subprogram body (e.g. when it is a protected operation).
	* sem_ch4.adb: minor reformatting

2011-09-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* lib.adb (Check_Same_Extended_Unit): Comment rewriting. Use
	Get_Source_Unit rather than Get_Code_Unit as instantiation unfolding
	may lead to wrong ancestor package in the case of instantiated subunit
	bodies. If a subunit is instantiated, follow the chain of instantiations
	rather than the stub structure.

From-SVN: r178530
parent 1e3a7e86
2011-09-05 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): If the expression
function comes from source, indicate that so does its rewriting,
so it is compatible with any subsequent expansion of the
subprogram body (e.g. when it is a protected operation).
* sem_ch4.adb: minor reformatting
2011-09-05 Hristian Kirtchev <kirtchev@adacore.com>
* lib.adb (Check_Same_Extended_Unit): Comment rewriting. Use
Get_Source_Unit rather than Get_Code_Unit as instantiation unfolding
may lead to wrong ancestor package in the case of instantiated subunit
bodies. If a subunit is instantiated, follow the chain of instantiations
rather than the stub structure.
2011-09-02 Robert Dewar <dewar@adacore.com> 2011-09-02 Robert Dewar <dewar@adacore.com>
* sem_ch4.adb, sem_ch6.adb: Minor reformatting. * sem_ch4.adb, sem_ch6.adb: Minor reformatting.
......
...@@ -293,10 +293,14 @@ package body Lib is ...@@ -293,10 +293,14 @@ package body Lib is
Sloc1 := S1; Sloc1 := S1;
Sloc2 := S2; Sloc2 := S2;
Unum1 := Get_Code_Unit (Sloc1);
Unum2 := Get_Code_Unit (Sloc2); Unum1 := Get_Source_Unit (Sloc1);
Unum2 := Get_Source_Unit (Sloc2);
loop loop
-- Step 1: Check whether the two locations are in the same source
-- file.
Sind1 := Get_Source_File_Index (Sloc1); Sind1 := Get_Source_File_Index (Sloc1);
Sind2 := Get_Source_File_Index (Sloc2); Sind2 := Get_Source_File_Index (Sloc2);
...@@ -310,28 +314,27 @@ package body Lib is ...@@ -310,28 +314,27 @@ package body Lib is
end if; end if;
end if; end if;
-- OK, the two nodes are in separate source elements, but this is not -- Step 2: Check subunits. If a subunit is instantiated, follow the
-- decisive, because of the issue of subunits and instantiations. -- instantiation chain rather than the stub chain.
-- First we deal with subunits, since if the subunit is in an
-- instantiation, we know that the parent is in the corresponding
-- instantiation, since that is the only way we can have a subunit
-- that is part of an instantiation.
Unit1 := Unit (Cunit (Unum1)); Unit1 := Unit (Cunit (Unum1));
Unit2 := Unit (Cunit (Unum2)); Unit2 := Unit (Cunit (Unum2));
Inst1 := Instantiation (Sind1);
Inst2 := Instantiation (Sind2);
if Nkind (Unit1) = N_Subunit if Nkind (Unit1) = N_Subunit
and then Present (Corresponding_Stub (Unit1)) and then Present (Corresponding_Stub (Unit1))
and then Inst1 = No_Location
then then
-- Both in subunits. They could have a common ancestor. If they
-- do, then the deeper one must have a longer unit name. Replace
-- the deeper one with its corresponding stub, in order to find
-- nearest common ancestor, if any.
if Nkind (Unit2) = N_Subunit if Nkind (Unit2) = N_Subunit
and then Present (Corresponding_Stub (Unit2)) and then Present (Corresponding_Stub (Unit2))
and then Inst2 = No_Location
then then
-- Both locations refer to subunits which may have a common
-- ancestor. If they do, the deeper subunit must have a longer
-- unit name. Replace the deeper one with its corresponding
-- stub in order to find the nearest ancestor.
if Length_Of_Name (Unit_Name (Unum1)) < if Length_Of_Name (Unit_Name (Unum1)) <
Length_Of_Name (Unit_Name (Unum2)) Length_Of_Name (Unit_Name (Unum2))
then then
...@@ -345,7 +348,7 @@ package body Lib is ...@@ -345,7 +348,7 @@ package body Lib is
goto Continue; goto Continue;
end if; end if;
-- Nod1 in subunit, Nod2 not -- Sloc1 in subunit, Sloc2 not
else else
Sloc1 := Sloc (Corresponding_Stub (Unit1)); Sloc1 := Sloc (Corresponding_Stub (Unit1));
...@@ -353,28 +356,25 @@ package body Lib is ...@@ -353,28 +356,25 @@ package body Lib is
goto Continue; goto Continue;
end if; end if;
-- Nod2 in subunit, Nod1 not -- Sloc2 in subunit, Sloc1 not
elsif Nkind (Unit2) = N_Subunit elsif Nkind (Unit2) = N_Subunit
and then Present (Corresponding_Stub (Unit2)) and then Present (Corresponding_Stub (Unit2))
and then Inst2 = No_Location
then then
Sloc2 := Sloc (Corresponding_Stub (Unit2)); Sloc2 := Sloc (Corresponding_Stub (Unit2));
Unum2 := Get_Source_Unit (Sloc2); Unum2 := Get_Source_Unit (Sloc2);
goto Continue; goto Continue;
end if; end if;
-- At this stage we know that neither is a subunit, so we deal -- Step 3: Check instances. The two locations may yield a common
-- with instantiations, since we could have a common ancestor -- ancestor.
Inst1 := Instantiation (Sind1);
Inst2 := Instantiation (Sind2);
if Inst1 /= No_Location then if Inst1 /= No_Location then
-- Both are instantiations
if Inst2 /= No_Location then if Inst2 /= No_Location then
-- Both locations denote instantiations
Depth1 := Instantiation_Depth (Sloc1); Depth1 := Instantiation_Depth (Sloc1);
Depth2 := Instantiation_Depth (Sloc2); Depth2 := Instantiation_Depth (Sloc2);
...@@ -396,7 +396,7 @@ package body Lib is ...@@ -396,7 +396,7 @@ package body Lib is
goto Continue; goto Continue;
end if; end if;
-- Only first node is in instantiation -- Sloc1 is an instantiation
else else
Sloc1 := Inst1; Sloc1 := Inst1;
...@@ -404,7 +404,7 @@ package body Lib is ...@@ -404,7 +404,7 @@ package body Lib is
goto Continue; goto Continue;
end if; end if;
-- Only second node is instantiation -- Sloc2 is an instantiation
elsif Inst2 /= No_Location then elsif Inst2 /= No_Location then
Sloc2 := Inst2; Sloc2 := Inst2;
...@@ -412,10 +412,9 @@ package body Lib is ...@@ -412,10 +412,9 @@ package body Lib is
goto Continue; goto Continue;
end if; end if;
-- No instantiations involved, so we are not in the same unit -- Step 4: One location in the spec, the other in the corresponding
-- However, there is one case still to check, namely the case -- body of the same unit. The location in the spec is considered
-- where one location is in the spec, and the other in the -- earlier.
-- corresponding body (the spec location is earlier).
if Nkind (Unit1) = N_Subprogram_Body if Nkind (Unit1) = N_Subprogram_Body
or else or else
...@@ -434,8 +433,8 @@ package body Lib is ...@@ -434,8 +433,8 @@ package body Lib is
end if; end if;
end if; end if;
-- If that special case does not occur, then we are certain that -- At this point it is certain that the two locations denote two
-- the two locations are really in separate units. -- entirely separate units.
return No; return No;
......
...@@ -4322,8 +4322,7 @@ package body Sem_Ch4 is ...@@ -4322,8 +4322,7 @@ package body Sem_Ch4 is
Error_Msg_Node_2 := First_Subtype (Prefix_Type); Error_Msg_Node_2 := First_Subtype (Prefix_Type);
Error_Msg_NE ("no selector& for}", N, Sel); Error_Msg_NE ("no selector& for}", N, Sel);
-- If prefix is incomplete, dd information -- If prefix is incomplete, add information
-- What is dd???
if Is_Incomplete_Type (Type_To_Use) then if Is_Incomplete_Type (Type_To_Use) then
declare declare
......
...@@ -298,6 +298,12 @@ package body Sem_Ch6 is ...@@ -298,6 +298,12 @@ package body Sem_Ch6 is
Make_Simple_Return_Statement (LocX, Make_Simple_Return_Statement (LocX,
Expression => Expression (N))))); Expression => Expression (N)))));
-- If the expression function comes from source, indicate that so does
-- its rewriting, so it is compatible with any subsequent expansion of
-- the subprogram body (e.g. when it is a protected operation).
Set_Comes_From_Source (New_Body, Comes_From_Source (N));
if Present (Prev) if Present (Prev)
and then Ekind (Prev) = E_Generic_Function and then Ekind (Prev) = E_Generic_Function
then then
......
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