From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00
	autolearn=unavailable autolearn_force=no version=3.4.4
Path: 
 eternal-september.org!reader01.eternal-september.org!reader02.eternal-september.org!.POSTED!not-for-mail
From: Simon Wright <simon@pushface.org>
Newsgroups: comp.lang.ada
Subject: Re: Error: allocation from empty storage pool
Date: Thu, 12 Jul 2018 12:41:52 +0100
Organization: A noiseless patient Spider
Message-ID: <lyin5kfzpb.fsf@pushface.org>
References: <pi789g$8c1$1@dont-email.me>
Mime-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: 8bit
Injection-Info: reader02.eternal-september.org;
 posting-host="9d9af1960e6a07ec0970d61630101481";
	logging-data="16780"; mail-complaints-to="abuse@eternal-september.org";
	posting-account="U2FsdGVkX1+6JR1p4HvGZ6cxYU1eNLIDjF26xaXrVok="
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.3 (darwin)
Cancel-Lock: sha1:kv9/BWDLVmIgSZlVLeZjHvuEmfI=
	sha1:0T2YzP6Wg2anIbNyNX+w8aryDxs=
Xref: reader02.eternal-september.org comp.lang.ada:53776
Date: 2018-07-12T12:41:52+01:00
List-Id: <comp.lang.ada>

"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.