[Bug ada/124107] New: 13.11.5(9.1/5) is not followed - finalization removes subpools from pools

[liam at liampwll dot com via Gcc-bugs]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=124107

            Bug ID: 124107
           Summary: 13.11.5(9.1/5) is not followed - finalization removes
                    subpools from pools
           Product: gcc
           Version: 15.2.1
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: ada
          Assignee: unassigned at gcc dot gnu.org
          Reporter: liam at liampwll dot com
                CC: dkm at gcc dot gnu.org
  Target Milestone: ---

I already mentioned this in PR ada/124106 and thought there was ambiguity in
the RM, but upon a second reading it's clear that GNAT's behaviour is
incorrect.

The RM, in 13.11.5, states that:

5/5   Finalization of a subpool has the following effects in the given order:

...

9.1/5   4. The subpool ceases to belong to any pool.

GNAT currently leaves the subpool attached to its assigned pool during
finalization. This means that after a subpool goes out of scope and is
finalized, the finalization of the pool it was attached to will attempt to
finalize the subpool which no longer exists. The below program will segfault on
x64, although this is only visible when running under GDB as signals seem to be
supressed at the point of the segfault:


pragma Extensions_Allowed (On);

with Ada.Text_IO;                   use Ada.Text_IO;
with System.Storage_Elements;       use System.Storage_Elements;
with System.Storage_Pools.Subpools; use System.Storage_Pools.Subpools;

procedure Example is
   type Test_Pool is new Root_Storage_Pool_With_Subpools with null record;
   type Test_Subpool is new Root_Subpool with null record;

   overriding
   function Create_Subpool
     (Pool : in out Test_Pool) return not null Subpool_Handle
   is (raise Constraint_Error);

   overriding
   procedure Deallocate_Subpool
     (Pool : in out Test_Pool; Subpool : in out Subpool_Handle)
   is null;

   overriding
   procedure Allocate_From_Subpool
     (Pool                     : in out Test_Pool;
      Storage_Address          : out System.Address;
      Size_In_Storage_Elements : Storage_Count;
      Alignment                : Storage_Count;
      Subpool                  : not null Subpool_Handle) is null;
begin
   declare
      Pool : Test_Pool;
   begin
      declare
         Subpool : aliased Test_Subpool;
         Handle  : Subpool_Handle := Subpool'Unchecked_Access;
      begin
         Set_Pool_Of_Subpool (Handle, Pool);
         --  Subpool finalized here.
      end;
      declare
         X : array (1 .. 1000) of Long_Integer := (others => 1) with Volatile;
      begin
         null; --  Overwrite stack.
      end;
   end;
end Example;