diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2023-02-09 16:05:16 +0100 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-05-22 10:44:11 +0200 |
commit | c58d5574ae74c414c73558288fad42c229695881 (patch) | |
tree | f764535b32066c00718a8cdcd5ae97a2e6b0e184 /gcc | |
parent | 8c7a0c389e2f1ff2be476c9b3c561cab7f9b17e2 (diff) | |
download | gcc-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.adb | 59 |
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 |