Блог

Учитывая общий родительский пакет:

 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;
 

есть ли способ в дочернем пакете гарантировать, что тип, передаваемый в дочерний как общий формальный, является тем же типом, что и родительский (или даже потомок). T? Например, рассмотрим общий дочерний пакет:

 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;
 

где База-это некоторый базовый тип с тегами. В качестве заполнителя можно использовать следующее:

 type Base is tagged limited null record;
 

Я ищу способ либо во время компиляции, либо во время выполнения проверить внутри родительской системы.Ребенок этого Родителя.Ребенок.T-это то же самое, что и Родитель.T (или даже если родитель.Ребенок.T является потомком родителя.T.

ПРИМЕЧАНИЕ: Я пытаюсь использовать отношение родительский дочерний пакет, потому что это позволяет ребенку видеть в личном разделе Родителя.

Наивно я попробовал что-то основанное на времени выполнения, например:

 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;
 

но это просто приводит к ошибке КОМАРА:

 premature usage of incomplete type "T"
 

потому что Родитель.T является неполным. Цель здесь состоит в том, чтобы создать систему автоматического управления памятью, которую можно использовать с неполными типами, чтобы родительский пакет обеспечивал большую часть функций, в то время как дочерний пакет можно создать позже и добавить функции, требующие полной информации о типе (например, создание/освобождение). Затем вы могли бы сделать такие заявления, как:

 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);
 

Полный набор тестового кода (пожалуйста, имейте в виду, что он является как необработанным, так и голым, чтобы сделать его как можно более простым):

 ------------------------ 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;
 

Если вам не нужны отношения родитель/потомок дженериков, вы можете сделать что-то вроде этого:

фу.объявления

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

end Foo;
 

бар.объявления

 with Foo;

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

Таким образом, полный тип должен точно соответствовать неполному типу, т. е. это не может быть расширением типа, таким образом:

 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;
 

В предыдущей версии этого ответа упущен тот факт, что Jere нуждается в нем для работы с формальными неполными типами, которые были введены с AI05-0213.

Одним из (основных?) вариантов использования этого ИИ было упрощение создания пакетов подписей (см. Обоснование Ada 2012, раздел 4.3) в некоторых обстоятельствах. Итак, вот предложение с использованием пакета подписи — понятия не имею, соответствует ли оно желаемому варианту использования.

 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;
 

В конце главы «Обоснование» строка

(Если все это слишком запутанно, не волнуйтесь, компилятор будет жаловаться на вас, если вы допустите ошибку.)

это, безусловно, правда. Что я обнаружил, играя с этим кодом, так это то, что он не очень хорошо говорит вам, в чем заключается ошибка.