給定一個通用的父包：
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;
在子包中是否有一種方法可以確保作為泛型形式傳遞給子包的型別與 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;
其中 Base 是一些基本標記型別。您可以使用以下內容作為占位符：
type Base is tagged limited null record;
我正在尋找一種編譯時或運行時的方法來驗證 Parent.Child 內部的 Parent.Child.T 與 Parent.T 相同（或者即使 Parent.Child.T 是 Parent.T 的后代。
注意：我正在嘗試使用父子包關系，因為它允許 Child 看到 Parent 的私有部分。
我天真地嘗試了一些基于運行時的東西：
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;
但這只會導致 GNAT 錯誤：
premature usage of incomplete type "T"
因為 Parent.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;
uj5u.com熱心網友回復：
如果您不需要泛型的父/子關系，則可以執行以下操作：
foo.ads
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;
uj5u.com熱心網友回復：
此答案的先前版本忽略了一個事實，即 Jere 需要它來處理AI05-0213中引入的形式不完整型別。
該 AI 的（主要？）用例之一是在某些情況下更容易創建簽名包（請參閱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;
在基本原理一章的末尾，行
（如果這太令人困惑了，別擔心，如果你犯了錯誤，編譯器會向你抱怨。）
當然是真的。我在玩這個代碼時發現它不太擅長告訴你錯誤是什么。
uj5u.com熱心網友回復：
所以我從 Simon Wright 的答案中得到了一些靈??感，其中包括一個簽名包。這本身還不夠，但它是最終解決方案的必要組成部分。基本上，由于 Ada 沒有提供驗證兩個通用形式型別是否相同的方法，我使用一個單獨的包在運行時通過為給定型別生成唯一 ID 來提供該功能，將該包傳遞給 Parent 和Parent.Child 包，并在 Parent.Child 正文中驗證包的兩個實體是否具有相同的 ID（因此是同一個包）。下面提供了一個示例：
簽名包的想法導致了以下ID包：
package Type_ID is
type ID is limited private;
function "="(L,R : ID) return Boolean;
generic
type Item_Type(<>);
package Unique_ID is
function Get_ID return ID;
end Unique_ID;
private
-- Implement ID however you wish, just needs to be a unique ID for
-- each package instantiation
end Type_ID;
然后我將父規范更改為：
with Type_ID;
generic
with package ID is new Type_ID.Unique_ID(<>);
package Parent is
type Instance is tagged private;
private
-- private stuff
end Parent;
Parent.Child 包規范已更新為：
with Base;
generic
type T(<>) is new Base.Instance with private;
with package ID is new Type_ID.Unique_ID(T);
package Parent.Child is
type T_Access is access T;
function Make(Ref : not null T_Access) return Parent.Instance;
end Parent.Child;
最后，驗證型別相同的部分。由于 Parent 和 Parent.Child 都采用 Type_ID.Unique_ID(<>) 的實體，我們只需要通過比較 Parent.Child 包體內的 Get_ID 函式的輸出來確保它們都是相同的實體：
package body Parent.Child is
-- Other implementation stuff
use all type Type_ID.ID;
begin
if Parent.ID.Get_ID /= Parent.Child.ID.Get_ID then
raise Program_Error with "Invalid type passed to child package";
end if;
end Parent.Child;
基本上添加我自己的運行時型別資訊。
包的實體化然后變成：
with Ada.Text_IO;
with Type_ID;
with Base;
with Parent;
with Parent.Child;
procedure Main is
type Test is tagged;
package ID is new Type_ID.Unique_ID(Test);
package P is new Parent(ID);
type Test is new Base.Instance with record
Thing : P.Instance;
end record;
package PC is new P.Child(Test,ID);
Thing : P.Instance := PC.Make(new Test);
begin
Ada.Text_IO.Put_Line("Hello");
end Main;
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/311173.html