[COMMITTED] ada: Fix latent issue in support for protected entries
Marc Poulhiès
poulhies@adacore.com
Tue May 23 08:09:12 GMT 2023
From: Eric Botcazou <ebotcazou@adacore.com>
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) <N_Subprogram_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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/einfo.ads | 21 -----------------
gcc/ada/exp_ch6.adb | 9 +++++---
gcc/ada/exp_ch7.adb | 10 ---------
gcc/ada/exp_ch9.adb | 35 ++++++++++++++++-------------
gcc/ada/gen_il-fields.ads | 1 -
gcc/ada/gen_il-gen-gen_entities.adb | 1 -
gcc/ada/gen_il-gen-gen_nodes.adb | 3 ++-
gcc/ada/inline.adb | 10 ---------
gcc/ada/sem_ch12.adb | 27 +---------------------
gcc/ada/sem_ch9.adb | 1 +
gcc/ada/sem_util.adb | 16 +++++++++++++
gcc/ada/sinfo.ads | 5 +++--
12 files changed, 48 insertions(+), 91 deletions(-)
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index d346eddac57..78a1534c749 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 3f81b2a6c27..28b746ba2c4 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 db2644fb287..98a62970cd0 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 b51c60ea506..e0eeec49c01 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 fd89fac869d..8a1db381c1f 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 d531e4a8efa..ebc0f204b03 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 a330f6913c5..864b7c49198 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 07f806a40de..b2ff7c9e405 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 c31d0c62faa..91a1fad444c 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 67f8aa9c7ba..90b0ff08540 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 7e302897888..22dc9376b92 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 ce54dd3fb91..b0ac6f900ed 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)
-----------------------------------
--
2.40.0
More information about the Gcc-patches
mailing list