[multiple changes]

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

	* exp_ch6.adb (Move_Activation_Chain): Rewritten. The routine
	no longer needs to search through the entities of the return
	statement scope to find the _chain.
	* sem_ch5.adb: Add with and use clauses for Exp_Ch6 and Sem_Ch6.
	(Analyze_Block_Statement): Add local variable
	Is_BIP_Return_Statement. Add machinery to install all entities
	produced by the expansion of the return object declaration.
	(Install_Return_Entities): New routine.
	* sem_ch6.ads, sem_ch6.adb (Install_Entity): Moved from body to spec.

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

	* sem_ch10.adb (Analyze_Context): Apply simple fixup if context
	of subunit is incomplete.
	(Analyze_Proper_Body): If parent spec is not available, do not
	attempt analysis.

From-SVN: r178549
This commit is contained in:
Arnaud Charlet 2011-09-05 16:15:16 +02:00
parent 5dcab3ca08
commit 0613fb3358
6 changed files with 115 additions and 30 deletions

View File

@ -1,3 +1,22 @@
2011-09-05 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch6.adb (Move_Activation_Chain): Rewritten. The routine
no longer needs to search through the entities of the return
statement scope to find the _chain.
* sem_ch5.adb: Add with and use clauses for Exp_Ch6 and Sem_Ch6.
(Analyze_Block_Statement): Add local variable
Is_BIP_Return_Statement. Add machinery to install all entities
produced by the expansion of the return object declaration.
(Install_Return_Entities): New routine.
* sem_ch6.ads, sem_ch6.adb (Install_Entity): Moved from body to spec.
2011-09-05 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.adb (Analyze_Context): Apply simple fixup if context
of subunit is incomplete.
(Analyze_Proper_Body): If parent spec is not available, do not
attempt analysis.
2011-09-05 Ed Schonberg <schonberg@adacore.com>
* sem_disp.adb (Find_Controlling_Arg): Add checks for

View File

@ -4645,38 +4645,29 @@ package body Exp_Ch6 is
---------------------------
function Move_Activation_Chain return Node_Id is
Chain_Formal : constant Entity_Id :=
Build_In_Place_Formal
(Par_Func, BIP_Activation_Chain);
To : constant Node_Id :=
New_Reference_To (Chain_Formal, Loc);
Master_Formal : constant Entity_Id :=
Build_In_Place_Formal (Par_Func, BIP_Master);
New_Master : constant Node_Id :=
New_Reference_To (Master_Formal, Loc);
Chain_Id : Entity_Id;
From : Node_Id;
begin
Chain_Id := First_Entity (Return_Statement_Entity (N));
while Chars (Chain_Id) /= Name_uChain loop
Chain_Id := Next_Entity (Chain_Id);
end loop;
From :=
Make_Attribute_Reference (Loc,
Prefix =>
New_Reference_To (Chain_Id, Loc),
Attribute_Name => Name_Unrestricted_Access);
-- ??? Not clear why "Make_Identifier (Loc, Name_uChain)" doesn't
-- work, instead of "New_Reference_To (Chain_Id, Loc)" above.
return
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Move_Activation_Chain), Loc),
Parameter_Associations => New_List (From, To, New_Master));
Parameter_Associations => New_List (
-- Source chain
Make_Attribute_Reference (Loc,
Prefix => Make_Identifier (Loc, Name_uChain),
Attribute_Name => Name_Unrestricted_Access),
-- Destination chain
New_Reference_To
(Build_In_Place_Formal (Par_Func, BIP_Activation_Chain), Loc),
-- New master
New_Reference_To
(Build_In_Place_Formal (Par_Func, BIP_Master), Loc)));
end Move_Activation_Chain;
-- Start of processing for Expand_N_Extended_Return_Statement
@ -4708,6 +4699,7 @@ package body Exp_Ch6 is
-- Recover the function body
Func_Bod := Unit_Declaration_Node (Par_Func);
if Nkind (Func_Bod) = N_Subprogram_Declaration then
Func_Bod := Parent (Parent (Corresponding_Body (Func_Bod)));
end if;

View File

@ -1650,6 +1650,16 @@ package body Sem_Ch10 is
if Present (Library_Unit (N)) then
Set_Corresponding_Stub (Unit (Library_Unit (N)), N);
-- If the subunit has severe errors, the spec of the enclosing
-- body may not be available, in which case do not try analysis.
if Serious_Errors_Detected > 0
and then No (Library_Unit (Library_Unit (N)))
then
return;
end if;
Analyze_Subunit (Library_Unit (N));
-- Otherwise we must load the subunit and link to it
@ -1990,6 +2000,16 @@ package body Sem_Ch10 is
null;
else
-- If a subunits has serious syntax errors, the context
-- may not have been loaded. Add a harmless unit name to
-- attempt processing.
if Serious_Errors_Detected > 0
and then No (Entity (Name (Item)))
then
Set_Entity (Name (Item), Standard_Standard);
end if;
Unit_Name := Entity (Name (Item));
while Is_Child_Unit (Unit_Name) loop
Set_Is_Visible_Child_Unit (Unit_Name);

View File

@ -29,6 +29,7 @@ with Checks; use Checks;
with Einfo; use Einfo;
with Errout; use Errout;
with Expander; use Expander;
with Exp_Ch6; use Exp_Ch6;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
with Lib; use Lib;
@ -44,6 +45,7 @@ with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Case; use Sem_Case;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Disp; use Sem_Disp;
with Sem_Elab; use Sem_Elab;
@ -836,10 +838,44 @@ package body Sem_Ch5 is
-----------------------------
procedure Analyze_Block_Statement (N : Node_Id) is
procedure Install_Return_Entities (Scop : Entity_Id);
-- Install all entities of return statement scope Scop in the visibility
-- chain except for the return object since its entity is reused in a
-- renaming.
-----------------------------
-- Install_Return_Entities --
-----------------------------
procedure Install_Return_Entities (Scop : Entity_Id) is
Id : Entity_Id;
begin
Id := First_Entity (Scop);
while Present (Id) loop
-- Do not install the return object
if not Ekind_In (Id, E_Constant, E_Variable)
or else not Is_Return_Object (Id)
then
Install_Entity (Id);
end if;
Next_Entity (Id);
end loop;
end Install_Return_Entities;
-- Local constants and variables
Decls : constant List_Id := Declarations (N);
Id : constant Node_Id := Identifier (N);
HSS : constant Node_Id := Handled_Statement_Sequence (N);
Is_BIP_Return_Statement : Boolean;
-- Start of processing for Analyze_Block_Statement
begin
-- In SPARK mode, we reject block statements. Note that the case of
-- block statements generated by the expander is fine.
@ -855,6 +891,16 @@ package body Sem_Ch5 is
return;
end if;
-- Detect whether the block is actually a rewritten return statement of
-- a build-in-place function.
Is_BIP_Return_Statement :=
Present (Id)
and then Present (Entity (Id))
and then Ekind (Entity (Id)) = E_Return_Statement
and then Is_Build_In_Place_Function
(Return_Applies_To (Entity (Id)));
-- Normal processing with HSS present
declare
@ -915,6 +961,14 @@ package body Sem_Ch5 is
Set_Block_Node (Ent, Identifier (N));
Push_Scope (Ent);
-- The block served as an extended return statement. Ensure that any
-- entities created during the analysis and expansion of the return
-- object declaration are once again visible.
if Is_BIP_Return_Statement then
Install_Return_Entities (Ent);
end if;
if Present (Decls) then
Analyze_Declarations (Decls);
Check_Completion;

View File

@ -181,9 +181,6 @@ package body Sem_Ch6 is
-- This procedure makes S, a new overloaded entity, into the first visible
-- entity with that name.
procedure Install_Entity (E : Entity_Id);
-- Make single entity visible (used for generic formals as well)
function Is_Non_Overriding_Operation
(Prev_E : Entity_Id;
New_E : Entity_Id) return Boolean;

View File

@ -179,6 +179,9 @@ package Sem_Ch6 is
-- Determines if two subtype definitions are fully conformant. Used
-- for entry family conformance checks (RM 6.3.1 (24)).
procedure Install_Entity (E : Entity_Id);
-- Place a single entity on the visibility chain
procedure Install_Formals (Id : Entity_Id);
-- On entry to a subprogram body, make the formals visible. Note that
-- simply placing the subprogram on the scope stack is not sufficient: