CODEWITHSUNDEEP
ada
Roger Wilco
Roger Wilco

Reputation: 102

Dynamic dispatching

I have a reasonable amount of experience with Ada, but I have never used objects before. I found I had to use them to avoid the complications of not null access discriminate record types with task safe data structures. I need to make a function that takes in a base class and based on an if statement do dynamic dispatching, but I get an "incompatible types" error if the type I am testing is not in the class in the conditional. Is what I want to do impossible in Ada?

with Ada.Text_IO; use Ada.Text_IO;
procedure Dispatch is
  type foo is tagged record
    bar : boolean;
  end record;
  type foo2 is new foo with record
    bar2 : boolean;
  end record;
  type foo3 is new foo with record
    bar3 : boolean;
  end record;
  f3 : foo3;
  procedure Do_Something(fubar : in out foo'class) is
  begin
    if fubar in foo2'class then
      fubar.bar2 := True;
    end if;
  end Do_Something;
begin
  Do_Something(f3);
end Dispatch;

Upvotes: 1

Views: 243

Answers (1)

Simon Wright
Simon Wright

Reputation: 25511

Here, your code fails to compile with dispatch.adb:16:15: no selector “bar2" for type “foo'class" defined at line 3; nothing about incompatible types.

Anyway, the problem with the code as posted is that there is no component bar2 in foo; the only components visible in an object through a view of type foo’class are those in an object of type foo.

To get round this, you can change the view of fubar to foo2:

if fubar in foo2'class then
   foo2 (fubar).bar2 := true;
end if;

However, this is not dispatching! To get a dispatching call you need

  • a primitive operation in the base type (none here)
  • a class-wide object or pointer (OK)

and you need a more complicated example, because you can only declare primitive operations in a package spec. Something like

package Dispatch is
   type Foo is tagged record
      Bar : Boolean;
   end record;
   procedure Update (F : in out Foo; B : Boolean) is null;  -- primitive
   type Foo2 is new Foo with record
      Bar2 : Boolean;
   end record;
   overriding procedure Update (F : in out Foo2; B : Boolean);
   type Foo3 is new Foo with record
      Bar3 : Boolean;
   end record;  -- inherits default Update
end Dispatch;

package body Dispatch is
   procedure Update (F : in out Foo2; B : Boolean) is
   begin
      F.Bar2 := B;
   end Update;
end Dispatch;

procedure Dispatch.Main is
   F3 : Foo3;
   procedure Do_Something(Fubar : in out Foo'Class) is
   begin
      Fubar.Update (True);  -- dispatches
   end Do_Something;
begin
   Do_Something(F3);
end Dispatch.Main;

Upvotes: 3

Related Questions