ada - How to save an Access type of a Discriminant record for later use

Question

Issue:

How do I save an Access Pointer to a discriminant record for use later on in the program? In main.adb (1) I demonstrate how I was able to get it to compile, but I get a runtime error: raised PROGRAM_ERROR : main.adb:14 accessibility check failed

Note:

This is small example program based on a much larger/complex codebase.

Constraints:

i. The solution is required to be Ada95 Compatible.

ii. The solution must not change the package specification of Foo.ads as this is existing code that must be used as-is.

foo.ads

with Interfaces;
package Foo is
   
       type Base_Class is abstract tagged limited private;
    
       type Base_Class_Ref is access all Base_Class'Class;
       for Base_Class_Ref'Storage_Size use 0;
    

        Max_Count : constant := 6;

        type Count_Type is new Interfaces.Unsigned_16 range 1 .. Max_Count;

        type Foo_Class (Max : Count_Type) is new Base_Class with private;

        type Foo_Class_Ref is access all Foo_Class;
        for Foo_Class_Ref'Storage_Size use 0;

        --
        procedure Initialize (This_Ptr : Access Foo_Class);
        
        --
        function Get_Using_Pointer (This_Ptr : in Foo_Class_Ref) return Interfaces.Unsigned_16;

private
   type Base_Class is abstract tagged limited null record;
   
   type My_Data_Type is
        record
           X, Y, Z : Interfaces.Unsigned_16;
        end record;

    type My_Data_Array is
        array (Count_Type range <>) of My_Data_Type;

    type Foo_Class (Max : Count_Type) is new Base_Class with
        record
            Other_Data : Interfaces.Unsigned_16;
            Data       : My_Data_Array(1 .. Max);
        end record;

end Foo;

foo.adb

package body Foo is

    -- --------------------------------------------------------------------
    procedure Initialize (This_Ptr : Access Foo_Class) is
    begin
        This_Ptr.Other_Data := 0;
        This_Ptr.Data := (others => (0,0,0));
    end Initialize;

    -- --------------------------------------------------------------------
    function Get_Using_Pointer (This_Ptr : in Foo_Class_Ref)
        return Interfaces.Unsigned_16 is
    begin
        return This_Ptr.Other_Data;
    end Get_Using_Pointer;

end Foo;

main.adb

-------------------------------------------------------------------------------
--
-- Issue:
-- How do I save an Access Pointer for later use (1) to a discriminent record?
--
-- Constraints:
--  i. The solution is required to be Ada95 Compatible.
-- ii. The solution must not change the package specification of Foo.ads
--
-------------------------------------------------------------------------------
--
with Interfaces;
with Foo;

procedure Main is

    Foo_Count : constant := 3;
    Foo_Obj   : aliased Foo.Foo_Class (Max => Foo_Count);

   procedure TEST (This_Ptr : access Foo.Foo_Class) is      

      -- (1) Save Pointer
      -- **** This Line reports: ****
      -- raised PROGRAM_ERROR : main.adb:14 accessibility check failed
      Foo_Ptr : Foo.Foo_Class_Ref := This_Ptr.all'Access;    -- This Compiles...
      
      -- ^^^ I know that this is not correct.
      --     But it was the only way I could find to get it to compile.      
      
      Data    : Interfaces.Unsigned_16;
      
   begin
      
      -- (2) Get Data
      Data := Foo.Get_Using_Pointer(This_Ptr => Foo_Ptr);    -- This Compiles...

   end;

begin

   Foo.Initialize(This_Ptr => Foo_Obj'Access);
   
   Test(This_Ptr => Foo_Obj'Access);
   
end Main;

Answer 1

Quick answer:

Foo_Ptr : Foo.Foo_Class_Ref := This_Ptr.all'Unchecked_Access;

Checked as far as I can with

lockheed:jerunh simon$ gnatmake main.adb -gnat95 -f
gcc -c -gnat95 main.adb
gcc -c -gnat95 foo.adb
gnatbind -x main.ali
gnatlink main.ali
lockheed:jerunh simon$ ./main
lockheed:jerunh simon$