From 0613fb3358d0a523ed8148c589852c28b4aa1eb9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 5 Sep 2011 16:15:16 +0200 Subject: [PATCH] [multiple changes] 2011-09-05 Hristian Kirtchev * 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 * 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 --- gcc/ada/ChangeLog | 19 ++++++++++++++++ gcc/ada/exp_ch6.adb | 46 ++++++++++++++++--------------------- gcc/ada/sem_ch10.adb | 20 ++++++++++++++++ gcc/ada/sem_ch5.adb | 54 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/sem_ch6.adb | 3 --- gcc/ada/sem_ch6.ads | 3 +++ 6 files changed, 115 insertions(+), 30 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bceb63248ed..35d8af94b4a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2011-09-05 Hristian Kirtchev + + * 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 + + * 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 * sem_disp.adb (Find_Controlling_Arg): Add checks for diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 82f11931167..3f37ad32ceb 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -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; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 33d8dda47e0..34f3ba4d9bd 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -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); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index d22f6ce792e..5b56a9dddc8 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -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; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index fbfef082665..83652d36e5e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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; diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads index 1ca6f3bebdb..6d5496c6ae6 100644 --- a/gcc/ada/sem_ch6.ads +++ b/gcc/ada/sem_ch6.ads @@ -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: