]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Ada: Fix finalization glitch for pools with subpools
authorEric Botcazou <ebotcazou@adacore.com>
Fri, 20 Feb 2026 19:46:30 +0000 (20:46 +0100)
committerEric Botcazou <ebotcazou@adacore.com>
Fri, 20 Feb 2026 19:52:35 +0000 (20:52 +0100)
Finalize_Pool calls Finalize_And_Deallocate on every subpool handle, but
the parameter is declared with In Out mode, so the call ends up writing
back the updated value into the node that was just deallocated.

gcc/ada/
* libgnat/s-stposu.adb (Finalize_Pool): Pass a local copy of the
handle in the call to Finalize_And_Deallocate.

gcc/ada/libgnat/s-stposu.adb

index 3ac2766172866364e77ca85f43f780f155c2bab0..bc55665e0e33a50b006db5796c8dc9cb37507077 100644 (file)
@@ -398,6 +398,7 @@ package body System.Storage_Pools.Subpools is
    procedure Finalize_Pool (Pool : in out Root_Storage_Pool_With_Subpools) is
       Curr_Ptr : SP_Node_Ptr;
       Ex_Occur : Exception_Occurrence;
+      Handle   : Subpool_Handle;
       Raised   : Boolean := False;
 
       function Is_Empty_List (L : not null SP_Node_Ptr) return Boolean;
@@ -432,16 +433,13 @@ package body System.Storage_Pools.Subpools is
       while not Is_Empty_List (Pool.Subpools'Unchecked_Access) loop
          Curr_Ptr := Pool.Subpools.Next;
 
-         --  Perform the following actions:
-
-         --    1) Finalize all objects chained on the subpool's collection
-         --    2) Remove the subpool from the owner's list of subpools
-         --    3) Deallocate the doubly linked list node associated with the
-         --       subpool.
-         --    4) Call Deallocate_Subpool
+         --  Finalize and deallocate the subpool. Beware that the node pointed
+         --  to by Curr_Ptr will be deallocated so may not be passed as actual
+         --  in the call, since the formal parameter is In Out.
 
          begin
-            Finalize_And_Deallocate (Curr_Ptr.Subpool);
+            Handle := Curr_Ptr.Subpool;
+            Finalize_And_Deallocate (Handle);
 
          exception
             when Fin_Occur : others =>