Jer*_*ere 6 generics types ada
给定一个通用父包:
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;
Run Code Online (Sandbox Code Playgroud)
子包中是否有一种方法可以确保作为通用形式传递给子级的类型与 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;
Run Code Online (Sandbox Code Playgroud)
其中 Base 是一些基本标记类型。您可以使用以下内容作为占位符:
type Base is tagged limited null record;
Run Code Online (Sandbox Code Playgroud)
我正在寻找一种编译时或运行时的方法来验证 Parent.Child 内部 Parent.Child.T 与 Parent.T 相同(或者即使 Parent.Child.T 是 Parent.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;
Run Code Online (Sandbox Code Playgroud)
但这只会导致 GNAT 错误:
premature usage of incomplete type "T"
Run Code Online (Sandbox Code Playgroud)
因为 Parent.T 不完整。这里的目的是创建一个可用于不完整类型的自动内存管理框架,因此父包提供了大部分功能,而子包可以稍后实例化并添加需要完整类型信息的功能(例如构造/解除分配)。然后您可以进行如下声明:
premature usage of incomplete type "T"
Run Code Online (Sandbox Code Playgroud)
全套测试代码(请记住,这都是原始的和裸露的,以使其尽可能简单):
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);
Run Code Online (Sandbox Code Playgroud)
所以我从 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;
Run Code Online (Sandbox Code Playgroud)
然后我将父规范更改为:
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;
Run Code Online (Sandbox Code Playgroud)
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;
Run Code Online (Sandbox Code Playgroud)
最后是验证类型是否相同的部分。由于 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;
Run Code Online (Sandbox Code Playgroud)
基本上添加我自己的运行时类型信息。
包的实例化则变为:
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;
Run Code Online (Sandbox Code Playgroud)