* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178549
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
---------------------------
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
-- 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;
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
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);
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;
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;
-----------------------------
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.
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
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;
-- 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;
-- 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:
OSDN Git Service
