Re: Inherited Methods and such

[Robert A Duff <bobduff@shell01.TheWorld.com>]

Robert A Duff <bobduff@shell01.TheWorld.com> writes:

> Maciej Sobczak <see.my.homepage@gmail.com> writes:
>> Constructor functions in Ada are functions that return new objects
>> (most useful for limited types since Ada 2005) can have parameters,
>> but they still don't acknowledge the "progressive" nature of the whole
>> process.
>
> I think they do, actually.

Here's an example.  What do you think?  Do you revise your opinion that
Ada doesn't properly support constructors?

We've got a Root_Window type, and a type derived from that,
for "red" windows (OK, I didn't bother with something more
realistic).

Note that this example dispatches during construction,
and dispatches the way C++ constructors would (shallow,
not deep).  But I think we both agree that dispatching
at all during construction is questionable.

(There's an AI on this issue, by the way.)

Maybe Root_Window should have unknown discriminants (<>),
to force the use of the provided constructors.

I get this output, using the latest (internal to AdaCore) version of
GNAT:

Evilly dispatching from Make_Root_Window.
Hello from Class_Wide
Hello from Primitive (Root_Window)
Goodbye from Class_Wide
Evilly dispatching from Make_Red_Window.
Hello from Class_Wide
Hello from Primitive (Red_Window)
Goodbye from Class_Wide
Hello from Class_Wide
Hello from Primitive (Red_Window)
Goodbye from Class_Wide

And here's the code:

with Ada.Text_IO; use Ada.Text_IO;
package Root_Windows is

   type Root_Window is tagged limited private;

   procedure Primitive (Win : Root_Window);
   procedure Class_Wide (Win : Root_Window'Class);

private

   type Root_Window is tagged limited
      record
         X : Integer;
      end record;

end Root_Windows;

package Root_Windows.Factory is

   function Make_Root_Window (X : Integer) return Root_Window;

end Root_Windows.Factory;

with Ada.Text_IO; use Ada.Text_IO;
with Root_Windows; use Root_Windows;
package Red_Windows is

   type Red_Window is new Root_Window with private;

   procedure Primitive (Win : Red_Window);

private

   type Red_Window is new Root_Window with
      record
         Y : Integer;
      end record;

end Red_Windows;

package Red_Windows.Factory is

   function Make_Red_Window (X, Y : Integer) return Red_Window;

end Red_Windows.Factory;

package body Root_Windows is

   procedure Primitive (Win : Root_Window) is
   begin
      Put_Line ("Hello from Primitive (Root_Window)");
   end Primitive;

   procedure Class_Wide (Win : Root_Window'Class) is
   begin
      Put_Line ("Hello from Class_Wide");
      Primitive (Win); -- dispatch
      Put_Line ("Goodbye from Class_Wide");
   end Class_Wide;

end Root_Windows;

package body Root_Windows.Factory is

   function Make_Root_Window (X : Integer) return Root_Window is
   begin
      return Result : Root_Window := (X => X) do
         Put_Line ("Evilly dispatching from Make_Root_Window.");
         Class_Wide (Result);
      end return;
   end Make_Root_Window;

end Root_Windows.Factory;

package body Red_Windows is

   procedure Primitive (Win : Red_Window) is
   begin
      Put_Line ("Hello from Primitive (Red_Window)");
   end Primitive;

end Red_Windows;

with Root_Windows.Factory;
package body Red_Windows.Factory is

   function Make_Red_Window (X, Y : Integer) return Red_Window is
   begin
      return Result : Red_Window :=
        (Root_Windows.Factory.Make_Root_Window (X) with Y => Y) do

         Put_Line ("Evilly dispatching from Make_Red_Window.");
         Class_Wide (Result);
      end return;
   end Make_Red_Window;

end Red_Windows.Factory;

with Red_Windows.Factory;
procedure Red_Windows.Test is
   My_Window : Root_Window'Class := Factory.Make_Red_Window (X => 1, Y => 2);
begin
   Class_Wide (My_Window);
end Red_Windows.Test;