Re: Ada Annoyances

[AdaMagica <christ-usch.grein@t-online.de>]

Am Montag, 26. Juni 2017 22:35:34 UTC+2 schrieb Maciej Sobczak:
> The complete example (analogous to the C++ example I have written in the other post) is:
> 
> with Ada.Text_IO;
> with Ada.Finalization;
> 
> procedure Test is
>    
>    package P is
>       type Base is new Ada.Finalization.Limited_Controlled with null record;
>       
>       procedure Initialize (Obj : in out Base);
>       procedure VFoo (Obj : in Base);
>       
>       type Derived is new Base with null record;
>       
>       procedure Initialize (Obj : in out Derived);
>       procedure VFoo (Obj : in Derived);
>       
>       procedure Use_Object (Obj : in Base'Class);
>    end P;
>    ...
> 
> When executed, we get:
> 
> test with Base
>    call from Base's Initialize
>       Hello from Base
> test with Derived
>    call from Base's Initialize
>       Hello from Derived   <<<<<<< here are dragons!
>    call from Derived's Initialize
>       Hello from Derived

Yes, this *is* a problem. The reason are the initialize *procedures* and the view conversion.
The following uses *functions* instead (which behave more like C++'s constructors). This program works correctly just like the C++ version.

(It seems that there is a bug in Gnat here. See comments in the code.)

package Maciej is

  type Base is tagged record
    I: Integer;  -- Gnat bug? Need this lest call of Base'(Create) will be optimized away
  end record;
  function Create return Base;
  procedure Foo (X: Base);

  type Derived is new Base with null record;
  function Create return Derived;
  procedure Foo (X: Derived);

  procedure Use_Object (X: Base'Class);

end Maciej;
-----------
with Ada.Text_IO;

package body Maciej is

  -- Ada hasn't constructors comparable with those of C++.

  function Create return Base is
    B: Base := (I => 19);  -- Here, the C++ constructor would be called.
  begin
    Ada.Text_IO.Put_Line ("  Calling Use_Object from Base constructor:");
    Use_Object (B);
    return B;
  end Create;

  procedure Foo (X: Base) is
  begin
    Ada.Text_IO.Put_Line ("    Hello from Base object!");
  end Foo;

  function Create return Derived is
    D: Derived := (Base'(Create) with null record);
  begin
    Ada.Text_IO.Put_Line ("  Calling Use_Object from Derived constructor:");
    Use_Object (D);
    return D;
  end Create;

  procedure Foo (X: Derived) is
  begin
    Ada.Text_IO.Put_Line ("    Hello from Derived object!");
  end Foo;

  procedure Use_Object (X: Base'Class) is
  begin
    X.Foo;
  end Use_Object;

end Maciej;
-----------
with Ada.Text_IO;
with Maciej;

procedure Maciej_Main is
begin
  Ada.Text_IO.Put_Line ("Test with Base object:");
  declare
    B: Maciej.Base := Maciej.Create;
  begin
    null;
  end;
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put_Line ("Test with Derived object:");
  declare
    D: Maciej.Derived := Maciej.Create;
  begin
    null;
  end;
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put_Line ("Same again with procedures:");
  declare
    B: Maciej.Base;
  begin
    B.Create;
  end;
  declare
    D: Maciej.Derived;
  begin
    D.Create;
  end;

end Maciej_Main;

Test with Base object:
  Calling Use_Object from Base constructor:
    Hello from Base object!

Test with Derived object:
  Calling Use_Object from Base constructor:
    Hello from Base object!
  Calling Use_Object from Derived constructor:
    Hello from Derived object!