Is there a way to verify two generic formals are the same type if one is incomplete?

Question

Given a generic parent package:

generic
    type T(<>) is tagged;
package Parent is
    type Instance is tagged private;
private
    type T_Access is access T;
    type Instance is tagged record
        Thing : T_Access := null;
    end record;
end Parent;

is there a way in a child package to ensure a type passed into the child as a generic formal is the same type as (or even a descendant of) Parent.T? For example, consider the generic child package:

generic
    type T(<>) is new Base with private;
package Parent.Child is
    type T_Access is access T;
    function Make(Ref : not null T_Access) return Parent.Instance;
end Parent.Child;

package body Parent.Child is

    function To_Parent(Source : T_Access) return Parent.T_Access is
    begin
        -- here is where I need to be able to safely convert 
        -- an access to the complete type to an access to the 
        -- incomplete type.  I can used Unchecked_Conversion,
        -- but that goes south if someone passes in a type to 
        -- Parent.Child that is not the same as Parent.  If
        -- I could know that Parent.Child.T is a descendant of
        -- Parent.T, I could just convert it (I think??).
    end To_Parent;

    function Make(Ref : not null T_Access) return Parent.Instance is
    begin
        return (Thing => To_Parent(Ref);
    end Make;

end Parent.Child;

where Base is some base tagged type. You can use the following as a placeholder:

type Base is tagged limited null record;

I'm looking for a way either compile time or runtime to verify inside of Parent.Child that Parent.Child.T is the same as Parent.T (or even if Parent.Child.T is a descendent of Parent.T.

NOTE: I am trying to use the parent child package relationship because it allows Child to see into the private section of Parent.

Naively I tried something runtime based like:

package body Parent.Child is

    -- other stuff

begin
    if Child.T not in Parent.T then
        raise Storage_Error with "Invalid type passed to child package";
    end if;
end Parent.Child;

but that just results in a GNAT error:

premature usage of incomplete type "T"

because Parent.T is incomplete. The intent here is to create an automatic memory management framework that can be used with incomplete types, so the parent package provides the majority of the functionality while the child package can be instantiated later and add functionality that requires the full type information (like construction/deallocation). You could then do declarations like:

type Test is tagged;
package B is new Parent(Test);

type Test is new Base with record
    Thing : Parent.Instance;
end record;

package M is new B.Child(Test);

Full set of test code (Please keep in mind that this is both raw and bare to keep it as simple as possible):

------------------------ Base Package ----------------------------
package Base is
   type Instance is tagged limited null record;
end Base;

----------------------- Parent Package ---------------------------
generic
    type T(<>) is tagged;
package Parent is
    type Instance is tagged private;
private
    type T_Access is access T;
    type Instance is tagged record
        Thing : T_Access := null;
    end record;
end Parent;

------------------------ Child Package ---------------------------
with Base;

generic
   type T(<>) is new Base.Instance with private;
package Parent.Child is
   
   type T_Access is access T;

   function Make(Ref : not null T_Access) return Parent.Instance;
   
end Parent.Child;

with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;

package body Parent.Child is

   -- Used later in code not shown, but needed
   -- and requires Child.T to be complete.
   procedure Finalize is new Ada.Unchecked_Deallocation
      (Object => T,
       Name   => T_Access);

   function To_Parent is new Ada.Unchecked_Conversion
      (Source => Child.T_Access,
       Target => Parent.T_Access);

   -- This is where things get IFFY.  I do unchecked conversions here.
   -- If Parent.T is not equal to Parent.Child.T, then this can go bad
   -- really fast.  If there was a way to verify the types were the same,
   -- then I could safely do this.  Or if there was a way for me to
   -- verify that Parent.Child.T was a descendant of Parent.T, then
   -- I could just convert them without unchecked_conversion.
   function Make(Ref : not null T_Access) return Parent.Instance is
      (Thing => To_Parent(Ref));

end Parent.Child;

---------------------------- Main -------------------------------
with Ada.Text_IO;
with Base;
with Parent;
with Parent.Child;

procedure Main is

   type Test is tagged;
   
   package P is new Parent(Test);

   type Test is new Base.Instance with record
      Thing :  P.Instance;
   end record;

   package PC is new P.Child(Test);

   Thing : P.Instance := PC.Make(new Test);

begin
   Ada.Text_IO.Put_Line("Hello");
end Main;

Answer 1

If you don't need the parent/child relationship of the generics, you can do something like this:

foo.ads

generic
   type T(<>) is tagged;
package Foo is

end Foo;

bar.ads

with Foo;

generic
   type T(<>) is tagged private;
   with package Foo_Instance is new Foo(T); --package parameter
package Bar is
 
end Bar;

This way, the complete type must exactly match the incomplete type, ie. it cannot be a type extension, thus:

with Foo;
with Bar;

package Baz is

   type Base is tagged;
   package Base_Foo is new Foo(Base);
   
   
   type Base is tagged null record;
   package Base_Bar is new Bar(Base, Base_Foo);
   
   
   type Extension is new Base with null record;
   package Extension_Bar is new Bar(Extension, Base_Foo); -- fails!

end Baz;

Answer 2

The previous version of this answer missed the fact that Jere needs it to work for formal incomplete types, which were introduced with AI05-0213.

One of the (main?) use cases for that AI was to make it easier to create signature packages (see the Ada 2012 Rationale, section 4.3) in some circumstances. So, here’s an offering using a signature package - no idea whether it meets the desired use case.

generic
   type T is tagged;
package Signature is
end Signature;

with Signature;
generic
   type T is tagged private;
   with package Sig is new Signature (T);
package Parent is
   subtype Parent_T is T;
   Instance : T;
end Parent;

generic
   type T is new Parent.Parent_T with private;
   with package Sig is new Signature (T);
package Parent.Child is
end Parent.Child;

with Signature;
with Parent.Child;
package User is
   type Base is tagged null record;
   procedure Proc (Param : Base);

   package Sig_For_Parent is new Signature (T => Base);
   package For_Parent is new Parent (T => Base, Sig => Sig_For_Parent);

   --  this is OK
   type Extension is new Base with null record;
   procedure Proc (Param : Extension);
   package Sig_For_Child is new Signature (T => Extension);
   package For_Child
   is new For_Parent.Child (T => Extension, Sig => Sig_For_Child);

   --  this fails
   type Wrong is tagged null record;  -- not in Base'Class
   package Sig_For_Wrong is new Signature (T => Wrong);
   package For_Wrong
   is new For_Parent.Child (T => Wrong, Sig => Sig_For_Wrong);

end User;

with Ada.Text_IO;
package body User is

   procedure Proc (Param : Base) is
   begin
      Ada.Text_IO.Put_Line ("Base_P's Proc called.");
   end Proc;

   procedure Proc (Param : Extension) is
   begin
      Ada.Text_IO.Put_Line ("Extension_P's Proc called.");
   end Proc;

end User;

with User;
procedure Test is
   Var : User.Extension;
begin
   Var.Proc;
end Test;

---

At the end of the Rationale chapter, the line

(If this is all too confusing, do not worry, the compiler will moan at you if you make a mistake.)

is certainly true. What I found while playing around with this code is that it’s not very good at telling you what the mistake is.