问题
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;
回答1:
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
回答2:
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;
来源：https://stackoverflow.com/questions/5920457/dynamic-dispatching-in-ada