Who is wrong, me or GNAT? :-)

Who is wrong, me or GNAT? :-)

[Mark Lundquist]

OK, here's the code:

--------------------------------------------
-- foo.adb
--------------------------------------------

 procedure Foo is

  package P is
   type T is abstract tagged null record;
   function Create return T is abstract;
  end P;


  package P1 is
   type T2 is new P.T with private;
  private
   type T1 is new P.T with null record;
   function Create return T1;

   type T2 is new T1 with null record;
   --
   -- Gnat takes error on this ^^^ line.
   --
   -- But T2 should inherit 'Create' from
   -- (concrete) type T1.

  end P1;

  package body P1 is
   function Create return T1 is
   begin
    return (null record);
   end Create;
  end P1;

 begin
  null;
 end Foo;
----------------------------------------

GNAT 3.13(p) says:
foo.adb:16:30: type must be declared abstract or "Create" overridden

Is this a bug in GNAT?  If not, what am I missing?

I was trying to come up with an idiom for inherited constructors for
descendants of an abstract tagged type, and this seemed like it ought to do
the trick (although it suffers from the fact that the intermediate derived
type, e.g. T1 in this case, would have to override all the abstract
primitives).

Any help appreciated...
thx
-- mark

Re: Who is wrong, me or GNAT? :-)

[Ed Falis]

Mark Lundquist wrote:

> OK, here's the code:
> 
> --------------------------------------------
> -- foo.adb
> --------------------------------------------
> 
>  procedure Foo is
> 
>   package P is
>    type T is abstract tagged null record;
>    function Create return T is abstract;
>   end P;
> 
> 
>   package P1 is
>    type T2 is new P.T with private;
>   private
>    type T1 is new P.T with null record;
>    function Create return T1;
> 
>    type T2 is new T1 with null record;
>    --
>    -- Gnat takes error on this ^^^ line.
>    --
>    -- But T2 should inherit 'Create' from
>    -- (concrete) type T1.
> 
>   end P1;
> 
>   package body P1 is
>    function Create return T1 is
>    begin
>     return (null record);
>    end Create;
>   end P1;
> 
>  begin
>   null;
>  end Foo;
> ----------------------------------------
> 
> GNAT 3.13(p) says:
> foo.adb:16:30: type must be declared abstract or "Create" overridden
> 
> Is this a bug in GNAT?  If not, what am I missing?
> 
> I was trying to come up with an idiom for inherited constructors for
> descendants of an abstract tagged type, and this seemed like it ought to do
> the trick (although it suffers from the fact that the intermediate derived
> type, e.g. T1 in this case, would have to override all the abstract
> primitives).
> 
> Any help appreciated...
> thx
> -- mark

RM 3.9.3 (4-6)

Functions with a controlling result must be explicitly overridden when 
the parent type is derived (or the derived type has to be declared 
abstract), as they're considered abstract in the derived type.

Re: Who is wrong, me or GNAT? :-)

[Mark Lundquist]

"Ed Falis" <efalis@mediaone.net> wrote in message
news:3C24DF92.7040205@mediaone.net...
>
> RM 3.9.3 (4-6)
>
> Functions with a controlling result must be explicitly overridden when
> the parent type is derived (or the derived type has to be declared
> abstract), as they're considered abstract in the derived type.
>

oh yeah, I let the abstractness of the root type confuse me about something
I already understood :-)... these go abstract for tagged types, because
there's no downcast from a specific tagged type and hence no conversion for
the result returned by the inherited body.  So I don't need any abstract
types to get this error :-)

thx
Mark

Re: Who is wrong, me or GNAT? :-)

[Matthew Heaney]

> Is this a bug in GNAT?  If not, what am I missing?

No, this is not a GNAT bug.

> I was trying to come up with an idiom for inherited constructors for
> descendants of an abstract tagged type, and this seemed like it ought to
do
> the trick (although it suffers from the fact that the intermediate derived
> type, e.g. T1 in this case, would have to override all the abstract
> primitives).

Constructors are never inherited.  If you want a function to return a value
of the type, then you should declare the function in a nested package, or
return a class-wide type.

package P is
   type T is tagged null record;
   package Constructors is
      function Create return T;
   end;
end P;

or

package P is
   type T is tagged null record;
   function Create return T'Class;
end P;


In both of these cases, the operation isn't primitive anymore.

Of course, in the schemata above there's nothing to guarantee that the
client has called your contructor, because he can do this:

declare
   O : P.T;
begin
   null;
end;

You can ensure that the ctor is called by declaring the type with unknown
discriminants:

package P is
   type T (<>) is tagged private;
   function Create return T'Class;
private
   type T is tagged null record;
end P;

Now a client is forced to initialize his object by calling the ctor, or
copying another object:

declare
   Ox : T;  --won't compile
   O1 : T'Class := Create;
   O2 : T'Class := O1;
begin
   null;
end;

You can prevent copies by declaring the type as limited (and indefinite),
and supplying a ctor that returns an access object:

package P is
   type T (<>) is tagged limited private;
   type T_Access is access all T;
   function New_T return T_Access;
   procedure Op (O : access T);
end P;

declare
   O : T_Access := New_T;
begin
   Op (O);
end;

If you're worried about memory leaks, then you can use controlled-ness
somewhere, eg

declare
   O : aliased T_Access := New_T;
   Control : Control_Type (O'Access);
begin
   Op (O);
end;

Here, Control_Type is a type that calls Free in its Finalize operation.
Another technique (which I demonstrated at the AdaUK meeting a few weeks ago
in London) is to use an "auto_ptr" a la C++:

declare
   O : Pointer_Type;
begin
   Set_Pointer (O, New_T);
   Op (+O);
end;

The auto_ptr object allows you to transfer ownership of an access object.
If the auto_ptr still owns an access object during its Finalize, it calls
Free.

You can also use a smart pointer:

declare
   O : Handle_Type := New_T;
begin
   Op (+O);
end;