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.

12 files changed, 48 insertions, 91 deletions

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index d346edd..78a1534 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 3f81b2a..28b746b 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 db2644f..98a6297 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 b51c60e..e0eeec4 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 fd89fac..8a1db38 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 d531e4a..ebc0f20 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 a330f69..864b7c4 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 07f806a..b2ff7c9 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 c31d0c6..91a1fad 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 67f8aa9..90b0ff0 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 7e30289..22dc937 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 ce54dd3..b0ac6f9 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)
 
       -----------------------------------