I am having trouble getting dynamic dispatching to work with Ada generics. Is there an elegant way (something better than conditions such as if X in A then ...
) to have the generic Print
procedure in package Test_Generics
call the corresponding more specific Print
procedures of the child objects?
with Ada.Text_IO;
procedure Test is
type Object is
abstract tagged limited null record;
type A is
limited new Object with null record;
type B is
limited new Object with null record;
generic
type T is abstract tagged limited private;
with procedure Print (X : access T'Class);
package Test_Generics is
procedure Call_Print (X : access T'Class);
end Test_Generics;
package body Test_Generics is
procedure Call_Print (X : access T'Class) is
begin
X.Print;
end Call_Print;
end Test_Generics;
procedure Print (X : access Object'Class) is
begin
X.Print; -- dispatch procedure call to one of the next two
end Print;
procedure Print (X : access A) is
begin
Ada.Text_IO.Put_Line ("Print A");
end Print;
procedure Print (X : access B) is
begin
Ada.Text_IO.Put_Line ("Print B");
end Print;
package Impl is new Test_Generics (Object, Print);
A1 : access A := new A;
B1 : access B := new B;
begin
Impl.Call_Print (A1);
end Test;
Error message
raised STORAGE_ERROR : test.adb:34 infinite recursion
You can’t dispatch without inheritance, and you can’t dispatch to an inherited subprogram without a subprogram to inherit from.
Abstract subprograms need to be declared in a package, which can be inside your Test
procedure:
package Base is
type Object is
abstract tagged limited null record;
procedure Print (X : Object) is abstract;
end Base;
use Base;
Then, you want to derive a concrete type and the corresponding subprogram; right next to each other is best, to make sure that the Print
is a "primitive subprogram" (in this context, one that can be dispatched to) of the type:
type A is
limited new Object with null record;
procedure Print (X : A) is
begin
Ada.Text_IO.Put_Line ("Print A");
end Print;
You can tell the generic that there’s a Print
, and it’s OK for it to be a dispatching subprogram:
generic
type T is abstract tagged limited private;
with procedure Print (X : T) is abstract;
package Test_Generics is
procedure Call_Print (X : access T'Class);
end Test_Generics;
Remember, the instantiation has to be done with a concrete instance of Object
, which has to have either its own Print
or an inherited one.
I hadn’t known that you could create a dispatching subprogram with only the body - I’d thought you needed a spec.
That’s the first time I’ve written a generic with an abstract subprogram parameter.