Re: A simple question about the "new" allocator

["G.B." <bauhaus@futureapps.invalid>]

On 12.08.14 09:35, Dmitry A. Kazakov wrote:
> On Mon, 11 Aug 2014 23:54:50 -0700 (PDT), NiGHTS wrote:
>
>> With all default configurations using a typical Ada compiler, will the following code run indefinitely without fail or will it eventually crash?
>>
>> procedure main is
>>
>>      Test : access Positive;
>>
>> begin
>>
>>      loop
>>          Test := new Positive;
>>      end loop;
>>
>> end main;
>>
>> If this does crash, what would be another way to write this program so
>> that it does not crash?
>>
>> I would prefer not to use Ada.Unchecked_Deallocation.
>
> Write a custom memory pool that does not allocate anything. Make Test a
> pointer to that pool.
>
> P.S. It might sound silly, but such pools are actually useful. When the
> object is already allocated and you want to initialize it and get a pointer
> to, one way to do that is using a fake allocator.

One such storage pool, tailored to the problem, and therefore likely
not applicable to every problem:

with System.Storage_Pools;
with System.Storage_Elements;

generic
    type T is private;
package My_Switching_Pool is

    pragma Preelaborate (My_Switching_Pool);

    use System;

    type Alternating_Pool
      is new Storage_Pools.Root_Storage_Pool with private;
    --  Provides storage for exactly two items of formal type `T`.

    overriding
    procedure Allocate
      (Pool                     : in out Alternating_Pool;
       Storage_Address          :    out Address;
       Size_In_Storage_Elements : in     Storage_Elements.Storage_Count;
       Alignment                : in     Storage_Elements.Storage_Count);
    --  makes the other of the two items available for storage

    overriding
    procedure Deallocate
      (Pool                     : in out Alternating_Pool;
       Storage_Address          : in     Address;
       Size_In_Storage_Elements : in     Storage_Elements.Storage_Count;
       Alignment                : in     Storage_Elements.Storage_Count);

    overriding
    function Storage_Size
      (Pool : Alternating_Pool) return Storage_Elements.Storage_Count;

private
    type Names is (Fst, Snd);
    type Pair is array (Names) of T;

    type Alternating_Pool
      is new Storage_Pools.Root_Storage_Pool with
       record
          In_Use : Names := Snd;
       end record;

    The_Data : Pair;

end My_Switching_Pool;

package body My_Switching_Pool is

    overriding
    procedure Allocate
      (Pool                     : in out Alternating_Pool;
       Storage_Address          :    out Address;
       Size_In_Storage_Elements : in     Storage_Elements.Storage_Count;
       Alignment                : in     Storage_Elements.Storage_Count)
    is
    begin
       -- switch components of `The_Data`
       Pool.In_Use := (if Pool.In_Use = Fst
                       then Snd
                       else Fst);
       Storage_Address := The_Data (Pool.In_Use)'Address;
    end Allocate;

    overriding
    procedure Deallocate
      (Pool                     : in out Alternating_Pool;
       Storage_Address          : in     Address;
       Size_In_Storage_Elements : in     Storage_Elements.Storage_Count;
       Alignment                : in     Storage_Elements.Storage_Count)
    is
    begin
       null;
    end Deallocate;

    overriding
    function Storage_Size
      (Pool : Alternating_Pool)
       return Storage_Elements.Storage_Count
    is
       use type Storage_Elements.Storage_Count;
    begin
       return Pair'Size / Storage_Elements.Storage_Element'Size;
    end Storage_Size;

end My_Switching_Pool;

with My_Switching_Pool;
procedure Main is

    package Two_Numbers is new My_Switching_Pool (T => Positive);

    The_Pool : Two_Numbers.Alternating_Pool;

    type Positive_Ptr is access Positive
       with Storage_Pool => The_Pool;

    Test : Positive_Ptr;

begin

    loop
       Test := new Positive;
    end loop;

end Main;