Dynamic dispatch in Ada

Question

I am having problems with dynamic dispatch, even with this simple example. I believe the problem is how I set up the types and methods, but can't see where!

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

Two things:

First, you must have the abstract specification Go_To_Vet so that delegation can take place (it also caught me a couple of times :-):

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

And the second is that Ada requires the parent definition to be in its own package:

 package Animal is type Animal_T is abstract tagged null record; procedure Go_To_Vet (A : in out Animal_T) is abstract; end Animal; 

The type definitions in your simple procedure should then be adjusted accordingly (here I just stumbled and used the Animal package to simplify):

 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; 

Compilation:

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

And finally:

 [18] Marc say: ./simple Cat 

Answer 2

How to assign A_Cow Aa? (Aa: = A_Cow; complains!)

You cannot and should not. Although they have a common base class, they are two different types. Compared to Java, trying to convert a cat to a cow will ClassCastException at runtime. Ada eliminates the problem at compile time, as does the Java generic declaration.

I extended the @Marc C example to show how you can call base class routines. Note the use of prefix notation in procedure Simple .

Addition. As you say cool programming , I have to add a few points related to the example below. In particular, operations with a wide class, such as Get_Weight and Set_Weight , are not inherited , but the prefix notation makes them available. In addition, these routines are rather far-fetched, since marked recording components are available directly, for example. 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;