aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2023-02-09 16:05:16 +0100
committerMarc Poulhiès <poulhies@adacore.com>2023-05-22 10:44:11 +0200
commitc58d5574ae74c414c73558288fad42c229695881 (patch)
treef764535b32066c00718a8cdcd5ae97a2e6b0e184 /gcc
parent8c7a0c389e2f1ff2be476c9b3c561cab7f9b17e2 (diff)
downloadgcc-c58d5574ae74c414c73558288fad42c229695881.zip
gcc-c58d5574ae74c414c73558288fad42c229695881.tar.gz
gcc-c58d5574ae74c414c73558288fad42c229695881.tar.bz2
ada: Fix missing finalization in separate package body
This directly comes from a loophole in the implementation. gcc/ada/ * exp_ch7.adb (Process_Package_Body): New procedure taken from... (Build_Finalizer.Process_Declarations): ...here. Call the above procedure to deal with both package bodies and package body stubs.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/exp_ch7.adb59
1 files changed, 37 insertions, 22 deletions
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index a02e28e..9ec03b7 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2138,6 +2138,9 @@ package body Exp_Ch7 is
-- This variable is used to determine whether a nested package or
-- instance contains at least one controlled object.
+ procedure Process_Package_Body (Decl : Node_Id);
+ -- Process an N_Package_Body node
+
procedure Processing_Actions
(Has_No_Init : Boolean := False;
Is_Protected : Boolean := False);
@@ -2149,6 +2152,35 @@ package body Exp_Ch7 is
-- Is_Protected should be set when the current declaration denotes a
-- simple protected object.
+ --------------------------
+ -- Process_Package_Body --
+ --------------------------
+
+ procedure Process_Package_Body (Decl : Node_Id) is
+ begin
+ -- Do not inspect an ignored Ghost package body because all
+ -- code found within will not appear in the final tree.
+
+ if Is_Ignored_Ghost_Entity (Defining_Entity (Decl)) then
+ null;
+
+ elsif Ekind (Corresponding_Spec (Decl)) /= E_Generic_Package then
+ Old_Counter_Val := Counter_Val;
+ Process_Declarations (Declarations (Decl), Preprocess);
+
+ -- The nested package body is the last construct to contain
+ -- a controlled object.
+
+ if Preprocess
+ and then Top_Level
+ and then No (Last_Top_Level_Ctrl_Construct)
+ and then Counter_Val > Old_Counter_Val
+ then
+ Last_Top_Level_Ctrl_Construct := Decl;
+ end if;
+ end if;
+ end Process_Package_Body;
+
------------------------
-- Processing_Actions --
------------------------
@@ -2536,29 +2568,12 @@ package body Exp_Ch7 is
-- Nested package bodies, avoid generics
elsif Nkind (Decl) = N_Package_Body then
+ Process_Package_Body (Decl);
- -- Do not inspect an ignored Ghost package body because all
- -- code found within will not appear in the final tree.
-
- if Is_Ignored_Ghost_Entity (Defining_Entity (Decl)) then
- null;
-
- elsif Ekind (Corresponding_Spec (Decl)) /= E_Generic_Package
- then
- Old_Counter_Val := Counter_Val;
- Process_Declarations (Declarations (Decl), Preprocess);
-
- -- The nested package body is the last construct to contain
- -- a controlled object.
-
- if Preprocess
- and then Top_Level
- and then No (Last_Top_Level_Ctrl_Construct)
- and then Counter_Val > Old_Counter_Val
- then
- Last_Top_Level_Ctrl_Construct := Decl;
- end if;
- end if;
+ elsif Nkind (Decl) = N_Package_Body_Stub
+ and then Present (Library_Unit (Decl))
+ then
+ Process_Package_Body (Proper_Body (Unit (Library_Unit (Decl))));
-- Handle a rare case caused by a controlled transient object
-- created as part of a record init proc. The variable is wrapped