diff mbox series

[COMMITTED] ada: Fix missing finalization in separate package body

Message ID 20230522085122.1727132-1-poulhies@adacore.com
State Accepted
Headers
Series [COMMITTED] ada: Fix missing finalization in separate package body |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Marc Poulhiès May 22, 2023, 8:51 a.m. UTC 
  From: Eric Botcazou <ebotcazou@adacore.com>

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.

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

---
 gcc/ada/exp_ch7.adb | 59 ++++++++++++++++++++++++++++-----------------
 1 file changed, 37 insertions(+), 22 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index a02e28e4b34..9ec03b7e4cd 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