ada - 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 的抽象规范，这样才能进行委托(delegate)(这也引起了我的注意:-):

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