[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:
parent
5dcab3ca08
commit
0613fb3358
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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:
|
||||
|
Loading…
Reference in New Issue
Block a user