diff mbox series

[COMMITTED] ada: Fix missing finalization in library-level instance body

Message ID 20230526073555.2068158-1-poulhies@adacore.com
State New
Headers show
Series [COMMITTED] ada: Fix missing finalization in library-level instance body | expand

Commit Message

Marc Poulhiès May 26, 2023, 7:35 a.m. UTC
From: Eric Botcazou <ebotcazou@adacore.com>

This extends the delaying mechanism present in the cases where the instance
is not at library level, so as to wait until after the instantiation of the
body is performed, before generating the finalizer of the compilation unit.

gcc/ada/

	* einfo.ads (Delay_Cleanups): Document new usage.
	* exp_ch7.ads (Build_Finalizer): New declaration.
	* exp_ch7.adb (Build_Finalizer.Process_Declarations): Do not treat
	library-level package instantiations specially.
	(Build_Finalizer): Return early for package bodies and specs that
	are not compilation units instead of using a more convoluted test.
	(Expand_N_Package_Body): Do not build a finalizer if Delay_Cleanups
	is set on the defining entity.
	(Expand_N_Package_Declaration): Likewise.
	* inline.ads (Pending_Body_Info): Reorder and add Fin_Scop.
	(Add_Pending_Instantiation): Add Fin_Scop parameter.
	* inline.adb (Add_Pending_Instantiation): Likewise and copy it into
	the Pending_Body_Info appended to Pending_Instantiations.
	(Add_Scope_To_Clean): Change parameter name to Scop and remove now
	irrelevant processing.
	(Cleanup_Scopes): Deal with scopes that are package specs or bodies.
	(Instantiate_Body): For package instantiations, deal specially with
	scopes that are package bodies and with scopes that are dynamic.
	Pass the resulting scope to Add_Scope_To_Clean directly.
	* sem_ch12.adb (Analyze_Package_Instantiation): In the case where a
	body is needed, compute the enclosing finalization scope and pass it
	in the call to Add_Pending_Instantiation.
	(Inline_Instance_Body): Adjust aggregate passed in the calls to
	Instantiate_Package_Body.
	(Load_Parent_Of_Generic): Likewise.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/einfo.ads    |  12 ++--
 gcc/ada/exp_ch7.adb  | 133 +++++--------------------------------
 gcc/ada/exp_ch7.ads  |  23 +++++++
 gcc/ada/inline.adb   | 154 ++++++++++++++++++++++++++++++-------------
 gcc/ada/inline.ads   |  14 ++--
 gcc/ada/sem_ch12.adb | 114 +++++++++++++++++---------------
 6 files changed, 222 insertions(+), 228 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 7dc2bd178cc..ef5201a68ff 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -864,12 +864,12 @@  package Einfo is
 --       and IN OUT parameters in the absence of errors).
 
 --    Delay_Cleanups
---       Defined in entities that have finalization lists (subprograms
---       blocks, and tasks). Set if there are pending generic body
---       instantiations for the corresponding entity. If this flag is
---       set, then generation of cleanup actions for the corresponding
---       entity must be delayed, since the insertion of the generic body
---       may affect cleanup generation (see Inline for further details).
+--       Defined in entities that have finalization lists (subprograms, blocks
+--       and tasks) or finalizers (package specs and bodies). Set if there are
+--       pending package body instantiations for the corresponding entity. If
+--       it is set, then generation of cleanup actions for the corresponding
+--       entity must be delayed, since the insertion of the package bodies may
+--       affect cleanup generation (see Inline for further details).
 
 --    Delta_Value
 --       Defined in fixed and decimal types. Points to a universal real
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 98a62970cd0..1586e8fbfca 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -281,29 +281,6 @@  package body Exp_Ch7 is
    --  does not contain the above constructs, the routine returns an empty
    --  list.
 
-   procedure Build_Finalizer
-     (N           : Node_Id;
-      Clean_Stmts : List_Id;
-      Mark_Id     : Entity_Id;
-      Top_Decls   : List_Id;
-      Defer_Abort : Boolean;
-      Fin_Id      : out Entity_Id);
-   --  N may denote an accept statement, block, entry body, package body,
-   --  package spec, protected body, subprogram body, or a task body. Create
-   --  a procedure which contains finalization calls for all controlled objects
-   --  declared in the declarative or statement region of N. The calls are
-   --  built in reverse order relative to the original declarations. In the
-   --  case of a task body, the routine delays the creation of the finalizer
-   --  until all statements have been moved to the task body procedure.
-   --  Clean_Stmts may contain additional context-dependent code used to abort
-   --  asynchronous calls or complete tasks (see Build_Cleanup_Statements).
-   --  Mark_Id is the secondary stack used in the current context or Empty if
-   --  missing. Top_Decls is the list on which the declaration of the finalizer
-   --  is attached in the non-package case. Defer_Abort indicates that the
-   --  statements passed in perform actions that require abort to be deferred,
-   --  such as for task termination. Fin_Id is the finalizer declaration
-   --  entity.
-
    procedure Build_Finalizer_Call (N : Node_Id; Fin_Id : Entity_Id);
    --  N is a construct that contains a handled sequence of statements, Fin_Id
    --  is the entity of a finalizer. Create an At_End handler that covers the
@@ -2498,73 +2475,6 @@  package body Exp_Ch7 is
                   end if;
                end if;
 
-               --  Call the xxx__finalize_body procedure of a library level
-               --  package instantiation if the body contains finalization
-               --  statements.
-
-               if Present (Generic_Parent (Spec))
-                 and then Is_Library_Level_Entity (Pack_Id)
-                 and then Present (Body_Entity (Generic_Parent (Spec)))
-               then
-                  if Preprocess then
-                     declare
-                        P : Node_Id;
-                     begin
-                        P := Parent (Body_Entity (Generic_Parent (Spec)));
-                        while Present (P)
-                          and then Nkind (P) /= N_Package_Body
-                        loop
-                           P := Parent (P);
-                        end loop;
-
-                        if Present (P) then
-                           Old_Counter_Val := Counter_Val;
-                           Process_Declarations (Declarations (P), Preprocess);
-
-                           --  Note that we are processing the generic body
-                           --  template and not the actually instantiation
-                           --  (which is generated too late for us to process
-                           --  it), so there is no need to update in particular
-                           --  Last_Top_Level_Ctrl_Construct here.
-
-                           if Counter_Val > Old_Counter_Val then
-                              Counter_Val := Old_Counter_Val;
-                              Set_Has_Controlled_Component (Pack_Id);
-                           end if;
-                        end if;
-                     end;
-
-                  elsif Has_Controlled_Component (Pack_Id) then
-
-                     --  We import the xxx__finalize_body routine since the
-                     --  generic body will be instantiated later.
-
-                     declare
-                        Id : constant Node_Id :=
-                          Make_Defining_Identifier (Loc,
-                            New_Finalizer_Name (Defining_Unit_Name (Spec),
-                              For_Spec => False));
-
-                     begin
-                        Set_Has_Qualified_Name       (Id);
-                        Set_Has_Fully_Qualified_Name (Id);
-                        Set_Is_Imported              (Id);
-                        Set_Has_Completion           (Id);
-                        Set_Interface_Name (Id,
-                          Make_String_Literal (Loc,
-                            Strval => Get_Name_String (Chars (Id))));
-
-                        Append_New_To (Finalizer_Stmts,
-                          Make_Subprogram_Declaration (Loc,
-                            Make_Procedure_Specification (Loc,
-                              Defining_Unit_Name => Id)));
-                        Append_To (Finalizer_Stmts,
-                          Make_Procedure_Call_Statement (Loc,
-                            Name => New_Occurrence_Of (Id, Loc)));
-                     end;
-                  end if;
-               end if;
-
             --  Nested package bodies, avoid generics
 
             elsif Nkind (Decl) = N_Package_Body then
@@ -3541,34 +3451,15 @@  package body Exp_Ch7 is
          end if;
       end if;
 
-      --  Do not process nested packages since those are handled by the
-      --  enclosing scope's finalizer. Do not process non-expanded package
-      --  instantiations since those will be re-analyzed and re-expanded.
+      --  We do not need to process nested packages since they are handled by
+      --  the finalizer of the enclosing scope, including at library level.
+      --  And we do not build two finalizers for an instance without body that
+      --  is a library unit (see Analyze_Package_Instantiation).
 
       if For_Package
-        and then
-          (not Is_Library_Level_Entity (Spec_Id)
-
-            --  Nested packages are library-level entities, but do not need to
-            --  be processed separately.
-
-            or else Scope_Depth (Spec_Id) /= Uint_1
-
-            --  Do not build two finalizers for an instance without body that
-            --  is a library unit (see Analyze_Package_Instantiation).
-
-            or else (Is_Generic_Instance (Spec_Id)
-                      and then Package_Instantiation (Spec_Id) = N))
-
-         --  Still need to process library-level package body instances, whose
-         --  instantiation was deferred and thus could not be seen during the
-         --  processing of the enclosing scope, and which may contain objects
-         --  requiring finalization.
-
-        and then not
-          (For_Package_Body
-            and then Is_Library_Level_Entity (Spec_Id)
-            and then Is_Generic_Instance (Spec_Id))
+        and then (not Is_Compilation_Unit (Spec_Id)
+                   or else (Is_Generic_Instance (Spec_Id)
+                             and then Package_Instantiation (Spec_Id) = N))
       then
          return;
       end if;
@@ -5188,7 +5079,9 @@  package body Exp_Ch7 is
    --  Encode entity names in package body
 
    procedure Expand_N_Package_Body (N : Node_Id) is
+      Id      : constant Entity_Id := Defining_Entity (N);
       Spec_Id : constant Entity_Id := Corresponding_Spec (N);
+
       Fin_Id  : Entity_Id;
 
    begin
@@ -5242,7 +5135,9 @@  package body Exp_Ch7 is
 
       Qualify_Entity_Names (N);
 
-      if Ekind (Spec_Id) /= E_Generic_Package then
+      if Ekind (Spec_Id) /= E_Generic_Package
+        and then not Delay_Cleanups (Id)
+      then
          Build_Finalizer
            (N           => N,
             Clean_Stmts => No_List,
@@ -5369,7 +5264,9 @@  package body Exp_Ch7 is
 
       Qualify_Entity_Names (N);
 
-      if Ekind (Id) /= E_Generic_Package then
+      if Ekind (Id) /= E_Generic_Package
+        and then not Delay_Cleanups (Id)
+      then
          Build_Finalizer
            (N           => N,
             Clean_Stmts => No_List,
diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads
index 37754dbd3f9..a131e55f5c3 100644
--- a/gcc/ada/exp_ch7.ads
+++ b/gcc/ada/exp_ch7.ads
@@ -118,6 +118,29 @@  package Exp_Ch7 is
    --  finalization master must be analyzed. Insertion_Node is the insertion
    --  point before which the master is to be inserted.
 
+   procedure Build_Finalizer
+     (N           : Node_Id;
+      Clean_Stmts : List_Id;
+      Mark_Id     : Entity_Id;
+      Top_Decls   : List_Id;
+      Defer_Abort : Boolean;
+      Fin_Id      : out Entity_Id);
+   --  N may denote an accept statement, block, entry body, package body,
+   --  package spec, protected body, subprogram body, or a task body. Create
+   --  a procedure which contains finalization calls for all controlled objects
+   --  declared in the declarative or statement region of N. The calls are
+   --  built in reverse order relative to the original declarations. In the
+   --  case of a task body, the routine delays the creation of the finalizer
+   --  until all statements have been moved to the task body procedure.
+   --  Clean_Stmts may contain additional context-dependent code used to abort
+   --  asynchronous calls or complete tasks (see Build_Cleanup_Statements).
+   --  Mark_Id is the secondary stack used in the current context or Empty if
+   --  missing. Top_Decls is the list on which the declaration of the finalizer
+   --  is attached in the non-package case. Defer_Abort indicates that the
+   --  statements passed in perform actions that require abort to be deferred,
+   --  such as for task termination. Fin_Id is the finalizer declaration
+   --  entity.
+
    procedure Build_Late_Proc (Typ : Entity_Id; Nam : Name_Id);
    --  Build one controlling procedure when a late body overrides one of the
    --  controlling operations.
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index b7dafde9cf9..a4c32e984da 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -334,17 +334,17 @@  package body Inline is
    -- Deferred Cleanup Actions --
    ------------------------------
 
-   --  The cleanup actions for scopes that contain instantiations is delayed
-   --  until after expansion of those instantiations, because they may contain
-   --  finalizable objects or tasks that affect the cleanup code. A scope
-   --  that contains instantiations only needs to be finalized once, even
-   --  if it contains more than one instance. We keep a list of scopes
-   --  that must still be finalized, and call cleanup_actions after all
-   --  the instantiations have been completed.
+   --  The cleanup actions for scopes that contain package instantiations with
+   --  a body are delayed until after the package body is instantiated. because
+   --  the body may contain finalizable objects or other constructs that affect
+   --  the cleanup code. A scope that contains such instantiations only needs
+   --  to be finalized once, even though it may contain more than one instance.
+   --  We keep a list of scopes that must still be finalized and Cleanup_Scopes
+   --  will be invoked after all the body instantiations have been completed.
 
    To_Clean : Elist_Id;
 
-   procedure Add_Scope_To_Clean (Inst : Entity_Id);
+   procedure Add_Scope_To_Clean (Scop : Entity_Id);
    --  Build set of scopes on which cleanup actions must be performed
 
    procedure Cleanup_Scopes;
@@ -783,7 +783,11 @@  package body Inline is
    --  Add_Pending_Instantiation --
    --------------------------------
 
-   procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id) is
+   procedure Add_Pending_Instantiation
+     (Inst     : Node_Id;
+      Act_Decl : Node_Id;
+      Fin_Scop : Node_Id := Empty)
+   is
       Act_Decl_Id : Entity_Id;
       Index       : Int;
 
@@ -802,11 +806,12 @@  package body Inline is
       --  for later processing by Instantiate_Bodies.
 
       Pending_Instantiations.Append
-        ((Act_Decl                 => Act_Decl,
+        ((Inst_Node                => Inst,
+          Act_Decl                 => Act_Decl,
+          Fin_Scop                 => Fin_Scop,
           Config_Switches          => Save_Config_Switches,
           Current_Sem_Unit         => Current_Sem_Unit,
           Expander_Status          => Expander_Active,
-          Inst_Node                => Inst,
           Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
           Scope_Suppress           => Scope_Suppress,
           Warnings                 => Save_Warnings));
@@ -838,37 +843,10 @@  package body Inline is
    -- Add_Scope_To_Clean --
    ------------------------
 
-   procedure Add_Scope_To_Clean (Inst : Entity_Id) is
-      Scop : constant Entity_Id := Enclosing_Dynamic_Scope (Inst);
+   procedure Add_Scope_To_Clean (Scop : Entity_Id) is
       Elmt : Elmt_Id;
 
    begin
-      --  If the instance appears in a library-level package declaration,
-      --  all finalization is global, and nothing needs doing here.
-
-      if Scop = Standard_Standard then
-         return;
-      end if;
-
-      --  If the instance is within a generic unit, no finalization code
-      --  can be generated. Note that at this point all bodies have been
-      --  analyzed, and the scope stack itself is not present, and the flag
-      --  Inside_A_Generic is not set.
-
-      declare
-         S : Entity_Id;
-
-      begin
-         S := Scope (Inst);
-         while Present (S) and then S /= Standard_Standard loop
-            if Is_Generic_Unit (S) then
-               return;
-            end if;
-
-            S := Scope (S);
-         end loop;
-      end;
-
       Elmt := First_Elmt (To_Clean);
       while Present (Elmt) loop
          if Node (Elmt) = Scop then
@@ -2816,16 +2794,19 @@  package body Inline is
    --------------------
 
    procedure Cleanup_Scopes is
-      Elmt : Elmt_Id;
       Decl : Node_Id;
+      Elmt : Elmt_Id;
+      Fin  : Entity_Id;
+      Kind : Entity_Kind;
       Scop : Entity_Id;
 
    begin
       Elmt := First_Elmt (To_Clean);
       while Present (Elmt) loop
          Scop := Node (Elmt);
+         Kind := Ekind (Scop);
 
-         if Ekind (Scop) = E_Block then
+         if Kind = E_Block then
             Decl := Parent (Block_Node (Scop));
 
          else
@@ -2839,14 +2820,55 @@  package body Inline is
             end if;
          end if;
 
-         Push_Scope (Scop);
-         Expand_Cleanup_Actions (Decl);
-         End_Scope;
+         --  Finalizers are built only for package specs and bodies that are
+         --  compilation units, so check that we do not have anything else.
+         --  Moreover, they must be built at most once for each entity during
+         --  the compilation of the main unit. However, if other units are
+         --  later compiled for inlining purposes, they may also contain body
+         --  instances and, therefore, appear again here, so we need to make
+         --  sure that we do not build two finalizers for them (note that the
+         --  contents of the finalizer for these units is irrelevant since it
+         --  is not output in the generated code).
+
+         if Kind in E_Package | E_Package_Body then
+            declare
+               Unit_Entity : constant Entity_Id :=
+                 (if Kind = E_Package then Scop else Spec_Entity (Scop));
+
+            begin
+               pragma Assert (Is_Compilation_Unit (Unit_Entity)
+                 and then (No (Finalizer (Scop))
+                            or else Unit_Entity /= Main_Unit_Entity));
+
+               if No (Finalizer (Scop)) then
+                  Build_Finalizer
+                    (N           => Decl,
+                     Clean_Stmts => No_List,
+                     Mark_Id     => Empty,
+                     Top_Decls   => No_List,
+                     Defer_Abort => False,
+                     Fin_Id      => Fin);
+
+                  if Present (Fin) then
+                     Set_Finalizer (Scop, Fin);
+                  end if;
+               end if;
+            end;
+
+         else
+            Push_Scope (Scop);
+            Expand_Cleanup_Actions (Decl);
+            End_Scope;
+         end if;
 
          Next_Elmt (Elmt);
       end loop;
    end Cleanup_Scopes;
 
+   -----------------------------------------------
+   -- Establish_Actual_Mapping_For_Inlined_Call --
+   -----------------------------------------------
+
    procedure Establish_Actual_Mapping_For_Inlined_Call
      (N                     : Node_Id;
       Subp                  : Entity_Id;
@@ -4831,6 +4853,8 @@  package body Inline is
       ------------------------
 
       procedure Instantiate_Body (Info : Pending_Body_Info) is
+         Scop : Entity_Id;
+
       begin
          --  If the instantiation node is absent, it has been removed as part
          --  of unreachable code.
@@ -4845,9 +4869,47 @@  package body Inline is
          elsif Nkind (Info.Inst_Node) = N_Package_Body then
             null;
 
-         elsif Nkind (Info.Act_Decl) = N_Package_Declaration then
+         --  For other package instances, instantiate the body and register the
+         --  finalization scope, if any, for subsequent generation of cleanups.
+
+         elsif Nkind (Info.Inst_Node) = N_Package_Instantiation then
+
+            --  If the enclosing finalization scope is a package body, set the
+            --  In_Package_Body flag on its spec. This is required, in the case
+            --  where the body contains other package instantiations that have
+            --  a body, for Analyze_Package_Instantiation to compute a correct
+            --  finalization scope.
+
+            if Present (Info.Fin_Scop)
+              and then Ekind (Info.Fin_Scop) = E_Package_Body
+            then
+               Set_In_Package_Body (Spec_Entity (Info.Fin_Scop), True);
+            end if;
+
             Instantiate_Package_Body (Info);
-            Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl));
+
+            if Present (Info.Fin_Scop) then
+               Scop := Info.Fin_Scop;
+
+               --  If the enclosing finalization scope is dynamic, the instance
+               --  may have been relocated, for example if it was declared in a
+               --  protected entry, protected subprogram, or task body.
+
+               if Is_Dynamic_Scope (Scop) then
+                  Scop :=
+                    Enclosing_Dynamic_Scope (Defining_Entity (Info.Act_Decl));
+               end if;
+
+               Add_Scope_To_Clean (Scop);
+
+               --  Reset the In_Package_Body flag if it was set above
+
+               if Ekind (Info.Fin_Scop) = E_Package_Body then
+                  Set_In_Package_Body (Spec_Entity (Info.Fin_Scop), False);
+               end if;
+            end if;
+
+         --  For subprogram instances, always instantiate the body
 
          else
             Instantiate_Subprogram_Body (Info);
diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads
index 9d836173320..65c0968c1e4 100644
--- a/gcc/ada/inline.ads
+++ b/gcc/ada/inline.ads
@@ -61,9 +61,15 @@  package Inline is
    --  See full description in body of Sem_Ch12 for more details
 
    type Pending_Body_Info is record
+      Inst_Node : Node_Id;
+      --  Node for instantiation that requires the body
+
       Act_Decl : Node_Id;
       --  Declaration for package or subprogram spec for instantiation
 
+      Fin_Scop : Node_Id;
+      --  Enclosing finalization scope for package instantiation
+
       Config_Switches : Config_Switches_Type;
       --  Capture the values of configuration switches
 
@@ -76,9 +82,6 @@  package Inline is
       --  If the body is instantiated only for semantic checking, expansion
       --  must be inhibited.
 
-      Inst_Node : Node_Id;
-      --  Node for instantiation that requires the body
-
       Scope_Suppress           : Suppress_Record;
       Local_Suppress_Stack_Top : Suppress_Stack_Entry_Ptr;
       --  Save suppress information at the point of instantiation. Used to
@@ -119,7 +122,10 @@  package Inline is
    --  Add E's enclosing unit to Inlined_Bodies so that E can be subsequently
    --  retrieved and analyzed. N is the node giving rise to the call to E.
 
-   procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id);
+   procedure Add_Pending_Instantiation
+     (Inst     : Node_Id;
+      Act_Decl : Node_Id;
+      Fin_Scop : Node_Id := Empty);
    --  Add an entry in the table of generic bodies to be instantiated.
 
    procedure Analyze_Inlined_Bodies;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index b8cd16080fe..4fefcc8fb46 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -4794,66 +4794,68 @@  package body Sem_Ch12 is
             Needs_Body := False;
          end if;
 
+         --  If the context requires a full instantiation, set things up for
+         --  subsequent construction of the body.
+
          if Needs_Body then
-            --  Indicate that the enclosing scopes contain an instantiation,
-            --  and that cleanup actions should be delayed until after the
-            --  instance body is expanded.
+            declare
+               Fin_Scop, S : Entity_Id;
 
-            Check_Forward_Instantiation (Gen_Decl);
-            if Nkind (N) = N_Package_Instantiation then
-               declare
-                  Enclosing_Master : Entity_Id;
+            begin
+               Check_Forward_Instantiation (Gen_Decl);
 
-               begin
-                  --  Loop to search enclosing masters
+               Fin_Scop := Empty;
 
-                  Enclosing_Master := Current_Scope;
-                  Scope_Loop : while Enclosing_Master /= Standard_Standard loop
-                     if Ekind (Enclosing_Master) = E_Package then
-                        if Is_Compilation_Unit (Enclosing_Master) then
-                           exit Scope_Loop;
-                        else
-                           Enclosing_Master := Scope (Enclosing_Master);
-                        end if;
+               --  For a package instantiation that is not a compilation unit,
+               --  indicate that cleanup actions of the innermost enclosing
+               --  scope for which they are generated should be delayed until
+               --  after the package body is instantiated.
+
+               if Nkind (N) = N_Package_Instantiation
+                 and then not Is_Compilation_Unit (Act_Decl_Id)
+               then
+                  S := Current_Scope;
+
+                  while S /= Standard_Standard loop
+                     --  Cleanup actions are not generated within generic units
+                     --  or in the formal part of generic units.
 
-                     elsif Is_Generic_Unit (Enclosing_Master)
-                       or else Ekind (Enclosing_Master) = E_Void
+                     if Inside_A_Generic
+                       or else Is_Generic_Unit (S)
+                       or else Ekind (S) = E_Void
                      then
-                        --  Cleanup actions will eventually be performed on the
-                        --  enclosing subprogram or package instance, if any.
-                        --  Enclosing scope is void in the formal part of a
-                        --  generic subprogram.
+                        exit;
 
-                        exit Scope_Loop;
+                     --  For package scopes, cleanup actions are generated only
+                     --  for compilation units, for spec and body separately.
 
-                     else
-                        Set_Delay_Cleanups (Enclosing_Master);
+                     elsif Ekind (S) = E_Package then
+                        if Is_Compilation_Unit (S) then
+                           if In_Package_Body (S) then
+                              Fin_Scop := Body_Entity (S);
+                           else
+                              Fin_Scop := S;
+                           end if;
 
-                        while Ekind (Enclosing_Master) = E_Block loop
-                           Enclosing_Master := Scope (Enclosing_Master);
-                        end loop;
+                           Set_Delay_Cleanups (Fin_Scop);
+                           exit;
 
-                        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_Cleanups (TBP);
-                              end if;
-                           end;
+                        else
+                           S := Scope (S);
                         end if;
 
-                        exit Scope_Loop;
-                     end if;
-                  end loop Scope_Loop;
-               end;
+                     --  Cleanup actions are generated for all dynamic scopes
 
-               --  Make entry in table
+                     else
+                        Fin_Scop := S;
+                        Set_Delay_Cleanups (Fin_Scop);
+                        exit;
+                     end if;
+                  end loop;
+               end if;
 
-               Add_Pending_Instantiation (N, Act_Decl);
-            end if;
+               Add_Pending_Instantiation (N, Act_Decl, Fin_Scop);
+            end;
          end if;
 
          Set_Categorization_From_Pragmas (Act_Decl);
@@ -5252,11 +5254,12 @@  package body Sem_Ch12 is
 
          Instantiate_Package_Body
            (Body_Info =>
-             ((Act_Decl                 => Act_Decl,
+             ((Inst_Node                => N,
+               Act_Decl                 => Act_Decl,
+               Fin_Scop                 => Empty,
                Config_Switches          => Config_Attrs,
                Current_Sem_Unit         => Current_Sem_Unit,
                Expander_Status          => Expander_Active,
-               Inst_Node                => N,
                Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
                Scope_Suppress           => Scope_Suppress,
                Warnings                 => Save_Warnings)),
@@ -5366,11 +5369,12 @@  package body Sem_Ch12 is
       else
          Instantiate_Package_Body
            (Body_Info =>
-             ((Act_Decl                 => Act_Decl,
+             ((Inst_Node                => N,
+               Act_Decl                 => Act_Decl,
+               Fin_Scop                 => Empty,
                Config_Switches          => Save_Config_Switches,
                Current_Sem_Unit         => Current_Sem_Unit,
                Expander_Status          => Expander_Active,
-               Inst_Node                => N,
                Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
                Scope_Suppress           => Scope_Suppress,
                Warnings                 => Save_Warnings)),
@@ -14694,13 +14698,14 @@  package body Sem_Ch12 is
                         Decl := First_Elmt (Previous_Instances);
                         while Present (Decl) loop
                            Info :=
-                             (Act_Decl                 =>
+                             (Inst_Node                => Node (Decl),
+                              Act_Decl                 =>
                                 Instance_Spec (Node (Decl)),
+                              Fin_Scop                 => Empty,
                               Config_Switches          => Save_Config_Switches,
                               Current_Sem_Unit         =>
                                 Get_Code_Unit (Sloc (Node (Decl))),
                               Expander_Status          => Exp_Status,
-                              Inst_Node                => Node (Decl),
                               Local_Suppress_Stack_Top =>
                                 Local_Suppress_Stack_Top,
                               Scope_Suppress           => Scope_Suppress,
@@ -14754,12 +14759,13 @@  package body Sem_Ch12 is
 
                   Instantiate_Package_Body
                     (Body_Info =>
-                       ((Act_Decl                 => True_Parent,
+                       ((Inst_Node                => Inst_Node,
+                         Act_Decl                 => True_Parent,
+                         Fin_Scop                 => Empty,
                          Config_Switches          => Save_Config_Switches,
                          Current_Sem_Unit         =>
                            Get_Code_Unit (Sloc (Inst_Node)),
                          Expander_Status          => Exp_Status,
-                         Inst_Node                => Inst_Node,
                          Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
                          Scope_Suppress           => Scope_Suppress,
                          Warnings                 => Save_Warnings)),