From: Eric Botcazou Date: Sat, 11 Feb 2023 12:12:53 +0000 (+0100) Subject: ada: Fix latent issue in support for protected entries X-Git-Tag: basepoints/gcc-15~9021 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ac243c845a2049c3e302a8ae81a01b53b467a2ff;p=thirdparty%2Fgcc.git ada: Fix latent issue in support for protected entries The problem is that, unlike for protected subprograms, the expansion of cleanups for protected entries is not delayed when they contain package instances with a body, so the cleanups are generated twice and this may yield two finalizers if the secondary stack is used in the entry body. This restores the delaying, which uncovers the missing propagation of the Uses_Sec_Stack flag as is done for protected subprograms, which in turn requires using a Corresponding_Spec field as for protected subprograms. This also gets rid of the Delay_Subprogram_Descriptors flag on entities, whose only remaining use in Expand_Cleanup_Actions was unreachable. The last change is to unconditionally reset the scopes in the case of protected subprograms when they are expanded, as is done in the case of protected entries. This makes it possible to remove the code adjusting the scope on the fly in Cleanup_Scopes but requires a few adjustments. gcc/ada/ * einfo.ads (Delay_Subprogram_Descriptors): Delete. * gen_il-fields.ads (Opt_Field_Enum): Remove Delay_Subprogram_Descriptors. * gen_il-gen-gen_entities.adb (Gen_Entities): Likewise. * gen_il-gen-gen_nodes.adb (N_Entry_Body): Add Corresponding_Spec. * sinfo.ads (Corresponding_Spec): Document new use. (N_Entry_Body): Likewise. * exp_ch6.adb (Expand_Protected_Object_Reference): Be prepared for protected subprograms that have been expanded. * exp_ch7.adb (Expand_Cleanup_Actions): Remove unreachable code. * exp_ch9.adb (Build_Protected_Entry): Add a local variable for the new block and propagate Uses_Sec_Stack from the corresponding spec. (Expand_N_Protected_Body) : Unconditionally reset the scopes of top-level entities in the new body. * inline.adb (Cleanup_Scopes): Do not adjust the scope on the fly. * sem_ch9.adb (Analyze_Entry_Body): Set Corresponding_Spec. * sem_ch12.adb (Analyze_Package_Instantiation): Remove obsolete code setting Delay_Subprogram_Descriptors and tidy up. * sem_util.adb (Scope_Within): Deal with protected subprograms that have been expanded. (Scope_Within_Or_Same): Likewise. --- diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index d346eddac57c..78a1534c7495 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -871,23 +871,6 @@ package Einfo is -- entity must be delayed, since the insertion of the generic body -- may affect cleanup generation (see Inline for further details). --- Delay_Subprogram_Descriptors --- Defined in entities for which exception subprogram descriptors --- are generated (subprograms, package declarations and package --- bodies). Defined if there are pending generic body instantiations --- for the corresponding entity. If this flag is set, then generation --- of the subprogram descriptor for the corresponding entities must --- be delayed, since the insertion of the generic body may add entries --- to the list of handlers. --- --- Note: for subprograms, Delay_Subprogram_Descriptors is set if and --- only if Delay_Cleanups is set. But Delay_Cleanups can be set for a --- a block (in which case Delay_Subprogram_Descriptors is set for the --- containing subprogram). In addition Delay_Subprogram_Descriptors is --- set for a library level package declaration or body which contains --- delayed instantiations (in this case the descriptor refers to the --- enclosing elaboration procedure). - -- Delta_Value -- Defined in fixed and decimal types. Points to a universal real -- that holds value of delta for the type, as given in the declaration @@ -5552,7 +5535,6 @@ package Einfo is -- Contains_Ignored_Ghost_Code -- Default_Expressions_Processed -- Delay_Cleanups - -- Delay_Subprogram_Descriptors -- Discard_Names -- Elaboration_Entity_Required -- Has_Completion @@ -5801,7 +5783,6 @@ package Einfo is -- Body_Needed_For_Inlining -- Body_Needed_For_SAL -- Contains_Ignored_Ghost_Code - -- Delay_Subprogram_Descriptors -- Discard_Names -- Elaborate_Body_Desirable (non-generic case only) -- Elaboration_Entity_Required @@ -5844,7 +5825,6 @@ package Einfo is -- SPARK_Pragma -- SPARK_Aux_Pragma -- Contains_Ignored_Ghost_Code - -- Delay_Subprogram_Descriptors -- Ignore_SPARK_Mode_Pragmas -- SPARK_Aux_Pragma_Inherited -- SPARK_Pragma_Inherited @@ -5918,7 +5898,6 @@ package Einfo is -- Elaboration_Entity_Required -- Default_Expressions_Processed -- Delay_Cleanups - -- Delay_Subprogram_Descriptors -- Discard_Names -- Has_Completion -- Has_Expanded_Contract (non-generic case only) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 3f81b2a6c270..28b746ba2c4e 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6265,10 +6265,13 @@ package body Exp_Ch6 is -- body subprogram points to itself. Proc := Current_Scope; - while Present (Proc) - and then Scope (Proc) /= Scop - loop + while Present (Proc) and then Scope (Proc) /= Scop loop Proc := Scope (Proc); + if Is_Subprogram (Proc) + and then Present (Protected_Subprogram (Proc)) + then + Proc := Protected_Subprogram (Proc); + end if; end loop; Corr := Protected_Body_Subprogram (Proc); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index db2644fb287a..98a62970cd0e 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -5054,16 +5054,6 @@ package body Exp_Ch7 is if not Actions_Required then return; - - -- If the current node is a rewritten task body and the descriptors have - -- not been delayed (due to some nested instantiations), do not generate - -- redundant cleanup actions. - - elsif Is_Task_Body - and then Nkind (N) = N_Subprogram_Body - and then not Delay_Subprogram_Descriptors (Corresponding_Spec (N)) - then - return; end if; -- If an extended return statement contains something like diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index b51c60ea5068..e0eeec49c016 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -3398,6 +3398,7 @@ package body Exp_Ch9 is Loc : constant Source_Ptr := Sloc (N); + Block_Id : Entity_Id; Bod_Id : Entity_Id; Bod_Spec : Node_Id; Bod_Stmts : List_Id; @@ -3456,11 +3457,12 @@ package body Exp_Ch9 is Analyze_Statements (Bod_Stmts); - Set_Scope (Entity (Identifier (First (Bod_Stmts))), - Protected_Body_Subprogram (Ent)); + Block_Id := Entity (Identifier (First (Bod_Stmts))); - Reset_Scopes_To - (First (Bod_Stmts), Entity (Identifier (First (Bod_Stmts)))); + Set_Scope (Block_Id, Protected_Body_Subprogram (Ent)); + Set_Uses_Sec_Stack (Block_Id, Uses_Sec_Stack (Corresponding_Spec (N))); + + Reset_Scopes_To (First (Bod_Stmts), Block_Id); case Corresponding_Runtime_Package (Pid) is when System_Tasking_Protected_Objects_Entries => @@ -8537,19 +8539,10 @@ package body Exp_Ch9 is New_Op_Spec := Corresponding_Spec (New_Op_Body); -- When the original subprogram body has nested subprograms, - -- the new body also has them, so set the flag accordingly - -- and reset the scopes of the top-level nested subprograms - -- and other declaration entities so that they now refer to - -- the new body's entity. (It would preferable to do this - -- within Build_Protected_Sub_Specification, which is called - -- from Build_Unprotected_Subprogram_Body, but the needed - -- subprogram entity isn't available via Corresponding_Spec - -- until after the above Analyze call.) + -- the new body also has them, so set the flag accordingly. - if Has_Nested_Subprogram (Op_Spec) then - Set_Has_Nested_Subprogram (New_Op_Spec); - Reset_Scopes_To (New_Op_Body, New_Op_Spec); - end if; + Set_Has_Nested_Subprogram + (New_Op_Spec, Has_Nested_Subprogram (New_Op_Spec)); -- Similarly, when the original subprogram body uses the -- secondary stack, the new body also does. This is needed @@ -8558,6 +8551,16 @@ package body Exp_Ch9 is Set_Uses_Sec_Stack (New_Op_Spec, Uses_Sec_Stack (Op_Spec)); + -- Now reset the scopes of the top-level nested subprograms + -- and other declaration entities so that they now refer to + -- the new body's entity (it would preferable to do this + -- within Build_Protected_Sub_Specification, which is called + -- from Build_Unprotected_Subprogram_Body, but the needed + -- subprogram entity isn't available via Corresponding_Spec + -- until after the above Analyze call). + + Reset_Scopes_To (New_Op_Body, New_Op_Spec); + -- Build the corresponding protected operation. This is -- needed only if this is a public or private operation of -- the type. diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index fd89fac869d2..8a1db381c1fc 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -490,7 +490,6 @@ package Gen_IL.Fields is Default_Expressions_Processed, Default_Value, Delay_Cleanups, - Delay_Subprogram_Descriptors, Delta_Value, Dependent_Instances, Depends_On_Private, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index d531e4a8efaa..ebc0f204b037 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -57,7 +57,6 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Debug_Info_Off, Flag), Sm (Default_Expressions_Processed, Flag), Sm (Delay_Cleanups, Flag), - Sm (Delay_Subprogram_Descriptors, Flag), Sm (Depends_On_Private, Flag), Sm (Disable_Controlled, Flag, Base_Type_Only), Sm (Discard_Names, Flag), diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index a330f6913c5c..864b7c49198f 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -1345,7 +1345,8 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Declarations, List_Id, Default_No_List), Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), Sy (At_End_Proc, Node_Id, Default_Empty), - Sm (Activation_Chain_Entity, Node_Id))); + Sm (Activation_Chain_Entity, Node_Id), + Sm (Corresponding_Spec, Node_Id))); Cc (N_Entry_Call_Alternative, Node_Kind, (Sy (Entry_Call_Statement, Node_Id), diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 07f806a40de9..b2ff7c9e405d 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -2824,16 +2824,6 @@ package body Inline is while Present (Elmt) loop Scop := Node (Elmt); - if Ekind (Scop) = E_Entry then - Scop := Protected_Body_Subprogram (Scop); - - elsif Is_Subprogram (Scop) - and then Is_Protected_Type (Underlying_Type (Scope (Scop))) - and then Present (Protected_Body_Subprogram (Scop)) - then - Scop := Protected_Body_Subprogram (Scop); - end if; - if Ekind (Scop) = E_Block then Decl := Parent (Block_Node (Scop)); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index c31d0c62faaf..91a1fad444cb 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -4810,16 +4810,7 @@ package body Sem_Ch12 is Scope_Loop : while Enclosing_Master /= Standard_Standard loop if Ekind (Enclosing_Master) = E_Package then if Is_Compilation_Unit (Enclosing_Master) then - if In_Package_Body (Enclosing_Master) then - Set_Delay_Subprogram_Descriptors - (Body_Entity (Enclosing_Master)); - else - Set_Delay_Subprogram_Descriptors - (Enclosing_Master); - end if; - exit Scope_Loop; - else Enclosing_Master := Scope (Enclosing_Master); end if; @@ -4835,35 +4826,19 @@ package body Sem_Ch12 is exit Scope_Loop; else - if Ekind (Enclosing_Master) = E_Entry - and then - Ekind (Scope (Enclosing_Master)) = E_Protected_Type - then - if not Expander_Active then - exit Scope_Loop; - else - Enclosing_Master := - Protected_Body_Subprogram (Enclosing_Master); - end if; - end if; - Set_Delay_Cleanups (Enclosing_Master); while Ekind (Enclosing_Master) = E_Block loop Enclosing_Master := Scope (Enclosing_Master); end loop; - if Is_Subprogram (Enclosing_Master) then - Set_Delay_Subprogram_Descriptors (Enclosing_Master); - - elsif Is_Task_Type (Enclosing_Master) then + if Is_Task_Type (Enclosing_Master) then declare TBP : constant Node_Id := Get_Task_Body_Procedure (Enclosing_Master); begin if Present (TBP) then - Set_Delay_Subprogram_Descriptors (TBP); Set_Delay_Cleanups (TBP); end if; end; diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 67f8aa9c7bad..90b0ff085402 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -1305,6 +1305,7 @@ package body Sem_Ch9 is Entry_Name := E; Set_Convention (Id, Convention (E)); Set_Corresponding_Body (Parent (E), Id); + Set_Corresponding_Spec (N, E); Check_Fully_Conformant (Id, E, N); if Ekind (Id) = E_Entry_Family then diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 7e302897888c..22dc9376b92d 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -27268,6 +27268,15 @@ package body Sem_Util is then return True; + -- The body of a protected operation is within the protected type + + elsif Is_Subprogram (Curr) + and then Present (Protected_Subprogram (Curr)) + and then Is_Protected_Type (Outer) + and then Scope (Protected_Subprogram (Curr)) = Outer + then + return True; + -- Outside of its scope, a synchronized type may just be private elsif Is_Private_Type (Curr) @@ -27309,6 +27318,13 @@ package body Sem_Util is then return True; + elsif Is_Subprogram (Curr) + and then Present (Protected_Subprogram (Curr)) + and then Is_Protected_Type (Outer) + and then Scope (Protected_Subprogram (Curr)) = Outer + then + return True; + elsif Is_Private_Type (Curr) and then Present (Full_View (Curr)) then diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index ce54dd3fb919..b0ac6f900edc 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1052,8 +1052,8 @@ package Sinfo is -- and their first named subtypes. -- Corresponding_Spec - -- This field is set in subprogram, package, task, and protected body - -- nodes, where it points to the defining entity in the corresponding + -- This field is set in subprogram, package, task, entry and protected + -- body nodes where it points to the defining entity in the corresponding -- spec. The attribute is also set in N_With_Clause nodes where it points -- to the defining entity for the with'ed spec, and in a subprogram -- renaming declaration when it is a Renaming_As_Body. The field is Empty @@ -6206,6 +6206,7 @@ package Sinfo is -- Declarations -- Handled_Statement_Sequence -- Activation_Chain_Entity + -- Corresponding_Spec -- At_End_Proc (set to Empty if no clean up procedure) -----------------------------------