Re: Error: allocation from empty storage pool

[Simon Wright <simon@pushface.org>]

"Alejandro R. Mosteo" <alejandro@mosteo.com> writes:

> In a library I'm trying to have all allocations done from
> user-specified storage pools. There is no restriction on using the
> heap, as long as it comes from a user pool (that can default to the
> regular heap, of course).
>
> The idea was then to use "pragma Default_Storage_Pool (null)" at the
> library root to ensure no use of default allocators, and wherever
> needed provide facilities to get a pool from the user.
>
> However, this test fails:
>
> ---8<---
>
> pragma Restrictions (No_Secondary_Stack); -- Just to be sure in this ex.
> pragma Default_Storage_Pool (null);
>
> procedure Anon is
>
>    type Holder is record
>       I : aliased Integer;
>    end record;
>
>    type Ref (Elem : access constant Integer) is limited null record;
>
>    function To_Ref (Hold : aliased Holder) return Ref is
>      (Elem => Hold.I'Access); -- Error in subject here
>
> begin
>    null;
> end Anon;
>
> ---8<---
>
> There's actually no allocation being made, and I could have a Holder
> variable in the stack, and take a reference, and still no pool would
> be used at all.
>
> So it seems this pragma is too naïve. To make it into questions:
>
> Is this the pragma expected behavior or a particularity of gnat? Is
> the approach reasonable? This is my first attempt at working in a
> "restricted" Ada environment so I don't really have a clear idea of
> the preferred way to do what I want. Also, I'd like if possible to
> avoid making everything generic on the user pool.

I'm 99% confident this is a bug in GNAT.

The repreentation of the generated code (-gnatG) for To_Ref is

   function to_ref (hold : aliased holder; to_refBIPalloc : natural;
     to_refBIPstoragepool :
     system__storage_pools__root_storage_pool_ptr; to_refBIPaccess :
     T5b) return ref is
   begin
      R14b : declare
         [subtype T12b is ref (hold.i'access)]
         type A16b is access all T12b;
         R17b : A16b := null;
         if to_refBIPalloc = 1 then
            R17b := A16b!(to_refBIPaccess);
         elsif to_refBIPalloc = 2 then
            R17b := new T12b[storage_pool =
              system__secondary_stack__ss_pool];
         elsif to_refBIPalloc = 3 then
            R17b := new T12b;
         elsif to_refBIPalloc = 4 then
            P15b : system__storage_pools__root_storage_pool renames
              to_refBIPstoragepool.all;
            R17b := new T12b[storage_pool = P15b];
         else
            [program_error "build in place mismatch"]
         end if;
         R13b : T12b renames R17b.all;
         R13b.elem := hold.i'access;
      begin
         return R13b;
      end R14b;
   end to_ref;

where to_refBIPalloc is a parameter determined by the compiler. In the
case of

   H : aliased Holder := (I => 42);
   R : Ref := To_Ref (H);

it's 1, and to_refBIPaccess is R'Unrestricted_Access.

The other cases are presumably to cope with other calling patterns
(can't imagine what), and in particular case 3 is a standard 'new',
which would be what triggers the error message.