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;

第二个是Ada要求父定义在自己的包中:

package Animal is

   type Animal_T is abstract tagged null record;

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

end Animal;

然后需要相应地调整Simple过程中的类型定义(这里我只是使用Animal包来保持简单):

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'S例子来告诉你如何可以调用基类的子程序.注意使用的前缀符号在procedure Simple.

附录:当你提到全班编程时,我应该添加一些与下面的例子相关的要点.特别是,类和范围的操作(例如Get_Weight和Set_Weight)不会被继承,但带有前缀的表示法使它们可用.而且,这些子程序是相当人为的,因为标记的记录组件可以直接访问,例如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;