[Bug ada/124106] New: Subpools are discarded from some allocations with qualified expressions

[liam at liampwll dot com via Gcc-bugs]

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

            Bug ID: 124106
           Summary: Subpools are discarded from some allocations with
                    qualified expressions
           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: ---

Created attachment 63674
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=63674&action=edit
Larger test case

When Expand_Allocator_Expression is called and it leads to
Build_Aggregate_In_Place or Build_Explicit_Assignment then a new Allocator node
is generated without Subpool_Handle_Name. This is obviously incorrect.

Simply passing Subpool_Handle_Name (N) into Make_Allocator node appears to fix
the issue. Null_Exclusion_Present is also missing but I do not know if that is
handled elsewhere.

Below is a trivial test case and attached is the package that I found this
issue in as well as a test case for it. That package appears to show some
memory corruption after applying my fix that may or may not be related, the
issue could very well be in my own code.


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

procedure Example is

   Big_Buffer : Storage_Array (1 .. 1000)
   with Alignment => Standard'Maximum_Alignment;

   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
   begin
      Storage_Address := Big_Buffer'Address;
   end Allocate_From_Subpool;

   Pool    : Test_Pool;
   Subpool : aliased Test_Subpool;
   Handle  : Subpool_Handle := Subpool'Unchecked_Access;

   type Test_Subpool_Access is access Test_Subpool;
   for Test_Subpool_Access'Storage_Pool use Pool;

   Ptr : Test_Subpool_Access;

begin
   Set_Pool_Of_Subpool (Handle, Pool);
   Ptr := new (Handle) Test_Subpool'(Root_Subpool with null record);
end Example;