Re: Dynamic binding

[Georg Bauhaus <rm.dash-bauhaus@futureapps.de>]

On 13.04.12 22:11, Katarina Olsson wrote:

> the output will be the following on stdout:
>
>>> parent a
>>> child b
>
> I have now attempted to reproduce the corresponding case in Ada. If I
> create a tagged record Object in package Parent, and then the
> corresponding procedures (or functions):
>
> procedure A (This : access all Object);
> procedure B (This : access all Object);

Just to make sure:
1) "access all Object" is not a pointer to "Object or a type derived
from Object". Just to Object.

2)It is, however, a pointer to something that is already
passed by reference: O-O types in Ada are pass-by-reference types.

(The "all" part requests that the object of type "Object" could
have been allocated from the heap (using "new"), or be declared
on the stack (without new).)

> ... then in package Child, I create a new Parent.Object:
>
> type Object is new Parent.Object with null record
>
> ...and override the B method:
>
> overrides
> procedure B (This : access all Object)
>
> This should correspond to the previous java case, shouldn't it?

The procedures will logically correspond to the Java methods
if you turn the This parameters into "Ada style" O-O references,
i.e., do not introduce pointers to references.

There will be dispatching if requested. The request is expressed,
for objects X of type "T, or derived from T", by writing

   X : T'Class  -- declaring a class-wide

when declaring objects, and

   T'Class (X)  -- converting to class-wide

when passing objects so that dispatching take place, dispatching
based on X's actual tag. (T'Class denotes a class of types, not
a class of objects.)

package O_O is

    type Parent is tagged null record;

    procedure A (This: in Parent);
    procedure B (This: in Parent);

    type Child is new Parent with
        record
           N : Natural;
        end record;

    overriding procedure B (This: in Child);

end O_O;

with Ada.Text_IO;

package body O_O is

    use Ada.Text_IO;

    procedure A (This: in Parent) is
    begin
       Put_Line ("parent a");
       B (Parent'Class (This));
    end A;

    procedure B (This: in Parent) is
    begin
       Put_Line ("parent b");
    end B;

    overriding
    procedure B (This: in Child) is
    begin
       Put_Line ("child b");
    end B;

    X : Parent'Class :=
        Child'(Parent with N => 42);

begin
    A (X);
end O_O;

$ ./o_o
parent a
child b
$