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) <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.

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index d346eddac57c5aecf4b693f7c3847b23cafa7edc..78a1534c7495f48b48a037071b462e0aa53d3a04 100644 (file)
--- 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 3f81b2a6c270a95aeb6e24903900aff289d907ab..28b746ba2c4e2a63e01b6b1e376eb7686734b0a3 100644 (file)
--- 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 db2644fb287a616abe7334c6377c6baf43c56da4..98a62970cd0e5da76d16b1784bf337a3e3f969cc 100644 (file)
--- 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 b51c60ea5068ea58ca851c106bc6bc872250e0ec..e0eeec49c01650c0f963560998c59607f6c267d0 100644 (file)
--- 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 fd89fac869d2edc088f65b490e6715c8e3b75657..8a1db381c1fcd2b569551b6a9af812aaf51b2c18 100644 (file)
--- 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 d531e4a8efaa5576b16b90a7eddf8f7f8000cf7b..ebc0f204b0372f16b077f9b3b02fdc463ed4acf6 100644 (file)
--- 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 a330f6913c5ca81c2a6fcb76b3c23b42698971ae..864b7c49198f04aa1a26b1601ca22e8c7d5f028c 100644 (file)
--- 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 07f806a40de9efaf39fa5bba77a478d0dd2453f4..b2ff7c9e405dd4ad052dcf92bd82ad0409813e1c 100644 (file)
--- 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 c31d0c62faaf8fd6c592ca6d728f36e884991323..91a1fad444cb4a0c59ca22e32c70ba62ec3f6c32 100644 (file)
--- 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 67f8aa9c7bad9983dbcc7921f1c46f668d29a75a..90b0ff0854028f5925b49e66dc066b3289a93ee5 100644 (file)
--- 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 7e302897888ce31716fc72ab2bf2fbc183db83c9..22dc9376b92da19f8c52d6d8b87f445e575cad65 100644 (file)
--- 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 ce54dd3fb9191f349acc9b64046907fa3e7d6926..b0ac6f900edc4f517055da6307d432e247c27a66 100644 (file)
--- 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)
 
       -----------------------------------