Ada中的动态调度

Question

即使有了这个简单的示例，我仍然无法使动态调度工作。我相信问题在于我如何设置类型和方法，但无法看到哪里！

with Ada.Text_Io; 
procedure Simple is 

    type Animal_T is abstract tagged null record; 

    type Cow_T is new Animal_T with record 
     Dairy : Boolean; 
    end record; 

    procedure Go_To_Vet (A : in out Cow_T) is 
    begin 
     Ada.Text_Io.Put_Line ("Cow"); 
    end Go_To_Vet; 

    type Cat_T is new Animal_T with record 
     Fur : Boolean; 
    end record; 

    procedure Go_To_Vet (A : in out Cat_T) 
    is 
    begin 
     Ada.Text_Io.Put_Line ("Cat"); 
    end Go_To_Vet; 

    A_Cat : Cat_T := (Animal_T with Fur => True); 
    A_Cow : Cow_T := (Animal_T with Dairy => False); 
    Aa : Animal_T'Class := A_Cat; 
begin 

    Go_To_Vet (Aa); -- ERROR This doesn't dynamically dispatch! 
end Simple; 

Answer 1

两件事情：

首先，你必须有Go_To_Vet的抽象规范，使代表团可以发生（这已经抓住了我几次，以及:-)：

procedure Go_To_Vet (A : in out Animal_T) is abstract; 

而第二个是，小梅要求父定义在它自己的包：

package Animal is 

    type Animal_T is abstract tagged null record; 

    procedure Go_To_Vet (A : in out Animal_T) is abstract; 

end Animal; 

个在您的简单程序的类型定义则需要进行相应的调整（在这里我只是withed和使用的动物包来保持它的简单）：

with Ada.Text_Io; 
with Animal; use Animal; 
procedure Simple is 

    type Cow_T is new Animal_T with record 
     Dairy : Boolean; 
    end record; 

    procedure Go_To_Vet (A : in out Cow_T) is 
    begin 
     Ada.Text_Io.Put_Line ("Cow"); 
    end Go_To_Vet; 

    type Cat_T is new Animal_T with record 
     Fur : Boolean; 
    end record; 

    procedure Go_To_Vet (A : in out Cat_T) 
    is 
    begin 
     Ada.Text_Io.Put_Line ("Cat"); 
    end Go_To_Vet; 

    A_Cat : Cat_T := (Animal_T with Fur => True); 
    A_Cow : Cow_T := (Animal_T with Dairy => False); 
    Aa : Animal_T'Class := A_Cat; 
begin 

    Go_To_Vet (Aa); -- ERROR This doesn't dynamically dispatch! DOES NOW!! :-) 
end Simple; 

编译：

[17] Marc say: gnatmake -gnat05 simple 
gcc -c -gnat05 simple.adb 
gcc -c -gnat05 animal.ads 
gnatbind -x simple.ali 
gnatlink simple.ali 

最后：

[18] Marc say: ./simple 
Cat 

Answer 2

如何将A_Cow分配给Aa？ （Aa：= A_Cow;抱怨！）

你不能也不应该。虽然它们共享一个基类，但它们是两种不同的类型。与Java相比，尝试将猫转换为母牛会在运行时导致ClassCastException。 Ada在编译时排除了这个问题，就像Java泛型声明一样。

我已经扩展了@Marc C的例子来展示你如何调用基类子程序可以。请注意在procedure Simple中使用prefixed notation。

附录：正如您提到的class wide programming，我应该添加一些与以下示例相关的观点。特别是，类别较宽的操作（如Get_Weight和Set_Weight）为not inherited，但prefixed notation使其可用。而且，由于带标记的记录组件可直接访问，所以这些子程序是相当设计的。 Tabby.Weight。

package Animal is 

    type Animal_T is abstract tagged record 
     Weight : Integer := 0; 
    end record; 

    procedure Go_To_Vet (A : in out Animal_T) is abstract; 
    function Get_Weight (A : in Animal_T'Class) return Natural; 
    procedure Set_Weight (A : in out Animal_T'Class; W : in Natural); 

end Animal; 

package body Animal is 

    function Get_Weight (A : in Animal_T'Class) return Natural is 
    begin 
     return A.Weight; 
    end Get_Weight; 

    procedure Set_Weight (A : in out Animal_T'Class; W : in Natural) is 
    begin 
     A.Weight := W; 
    end Set_Weight; 

end Animal; 

with Ada.Text_IO; use Ada.Text_IO; 
with Animal; use Animal; 
procedure Simple is 

    type Cat_T is new Animal_T with record 
     Fur : Boolean; 
    end record; 

    procedure Go_To_Vet (A : in out Cat_T) 
    is 
    begin 
     Ada.Text_Io.Put_Line ("Cat"); 
    end Go_To_Vet; 

    type Cow_T is new Animal_T with record 
     Dairy : Boolean; 
    end record; 

    procedure Go_To_Vet (A : in out Cow_T) is 
    begin 
     Ada.Text_Io.Put_Line ("Cow"); 
    end Go_To_Vet; 

    A_Cat : Cat_T := (Weight => 5, Fur => True); 
    A_Cow : Cow_T := (Weight => 200, Dairy => False); 
    Tabby : Animal_T'Class := A_Cat; 
    Bossy : Animal_T'Class := A_Cow; 

begin 
    Go_To_Vet (Tabby); 
    Put_Line (Tabby.Get_Weight'Img); 
    Go_To_Vet (Bossy); 
    Put_Line (Bossy.Get_Weight'Img); 
    -- feed Bossy 
    Bossy.Set_Weight (210); 
    Put_Line (Bossy.Get_Weight'Img); 
end Simple;