Dynamic dispatching in Ada

Question

I am having trouble getting dynamic dispatching to work, even with this simple example. I believe the problem is in how i have set up the types and methods, but cannot 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;

score 8 · Accepted Answer · answered May 07 '11 at 12:07

8

Two things:

The first is that you have to have an abstract specification of Go_To_Vet, so that delegation can take place (this has caught me a couple times as well :-):

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

And the second is that Ada requires the parent definition 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 then need to be adjusted accordingly (here I just withed and used the Animal package to keep it simple):

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;

Compiling:

[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

answered May 07 '11 at 12:07

Marc C

8,664
1
24
29

Thanks Marc, I knew it was something like that ! my lesser question is how to assign a_Cow to aa ? (aa := a_cow; complains!) – NWS May 07 '11 at 14:34
+1 Good example. @NWS: The assignment is forbidden, as discussed in an adjacent [answer](http://stackoverflow.com/questions/5920457/dynamic-dispatching-in-ada/5928561#5928561). – trashgod May 08 '11 at 16:06
Thanks Trash, i thought the assignment was possible, but have got around that problem by class wide pointers :) which was what i was probably thinking of anyway.... – NWS May 08 '11 at 18:14
1

Interesting that you can get away without subprogram specs for the two concrete `Go_To_Vet` procedures. You do have to put the bodies immediately after the type declaration, though. – Simon Wright May 08 '11 at 22:42
1

@Simon Wright: It only works for the first subprogram; a second one produces "overriding of _name_ is too late." Happily, the error message is "spec should appear immediately after the type." – trashgod May 09 '11 at 04:02
1

@Simon Wright: Inadvertently omitting the abstract subprogram spec has left me pulling my hair (what little of it remains) out on more than one occasion. Fortunately, though, because of those experiences this is now one of the first things I check for when having a problem setting up dispatching. – Marc C May 09 '11 at 13:56
@trashgod: exploring this question was the first time I've declared a type extension in a non-package declarative region, so I was a bit surprised that you even can! – Simon Wright May 09 '11 at 19:13

trashgod · Answer 2 · 2011-05-09T03:21:28.037

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

You can't and shouldn't. Although they share a common base class, they are two different types. By comparison to Java, an attempt to convert a cat to a cow would cause a ClassCastException at run time. Ada precludes the problem at compile time, much as a Java generic declaration does.

I've expanded @Marc C's example to show how you can invoke base class subprograms. Note the use of prefixed notation in procedure Simple.

Addendum: As you mention class wide programming, I should add a few points related to the example below. In particular, class wide operations, such as Get_Weight and Set_Weight, are not inherited, but the prefixed notation makes them available. Also, these subprograms are rather contrived, as the tagged record components are accessible directly, e.g. 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;

@NWS: I appreciate the check-mark, but @Marc C's answer preceded mine. I would happily defer to him, if you change your mind. And, of course, you can always up-vote any answer you found useful. :-) — trashgod, May 08 '11 at 22:54
Upvote to you for your magnanimity (and it's a good elaboration :-) — Marc C, May 09 '11 at 13:40
You *COULD* do the assignment by making the variable aa an access to the class-wide type; there are, however, some restrictions to keep in mind: 1) you cannot assign [an access to] an item of a differing class to this directly, you must use NEW; 2) if, for some reason, you are trying to construct a class-wide variable [non-access] dynamically (say from a file, or a keyboard) then you probably should instantiate Generic_Dispatching_Constructor, see: http://www.adaic.org/resources/add_content/standards/05rat/html/Rat-2-6.html — Shark8, May 10 '11 at 23:21
@Shark8: Thanks for that [link](http://www.adaic.org/resources/add_content/standards/05rat/html/Rat-2-6.html). I can't help but notice the similarity to [`newInstance()`](http://download.oracle.com/javase/6/docs/api/java/lang/reflect/Constructor.html#newInstance%28java.lang.Object...%29). — trashgod, May 11 '11 at 02:13

Dynamic dispatching in Ada

2 Answers2

Linked