Динамическая диспетчеризация в Аде

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

как назначить A_Cow для Aa? (Aa: = A_Cow; жалуется!)

Ты не можешь и не должен. Хотя они имеют общий базовый класс, они бывают двух разных типов. По сравнению с Java, попытка превратить кошку в корову вызовет ClassCastException во время выполнения. Ada устраняет проблему во время компиляции, так же как и обобщенное объявление Java.

Я расширил пример @Marc C, чтобы показать, как может вызывать подпрограммы базового класса. Обратите внимание на использование префиксной нотации в 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;

Answer 2

Две вещи:

Во-первых, вам нужно иметь абстрактную спецификацию 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;

Определения типов в вашей простой процедуре должны быть соответствующим образом скорректированы (здесь я только что использовал и использовалпакет 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