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的示例，以展示如何调用基类子程序。请注意在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;

Ada中的动态调度

2 个答案: