From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-0.9 required=5.0 tests=BAYES_00,FORGED_GMAIL_RCVD,
	FREEMAIL_FROM autolearn=no autolearn_force=no version=3.4.4
X-Google-Thread: a07f3367d7,43127f177a55dc41,start
X-Google-Attributes: gida07f3367d7,public,usenet
X-Google-NewGroupId: yes
X-Google-Language: ENGLISH,ASCII-7-bit
Received: by 10.42.141.194 with SMTP id p2mr15433484icu.8.1320358608842;
        Thu, 03 Nov 2011 15:16:48 -0700 (PDT)
Path: 
 p6ni67893pbn.0!nntp.google.com!news2.google.com!postnews.google.com!c1g2000vbw.googlegroups.com!not-for-mail
From: Simon Belmont <sbelmont700@gmail.com>
Newsgroups: comp.lang.ada
Subject: limited allocated classwide types
Date: Thu, 3 Nov 2011 15:01:06 -0700 (PDT)
Organization: http://groups.google.com
Message-ID: <0ed43f83-40e7-46d3-8cc4-e1c41f500d28@c1g2000vbw.googlegroups.com>
NNTP-Posting-Host: 24.218.138.255
Mime-Version: 1.0
X-Trace: posting.google.com 1320358608 16980 127.0.0.1 (3 Nov 2011 22:16:48
 GMT)
X-Complaints-To: groups-abuse@google.com
NNTP-Posting-Date: Thu, 3 Nov 2011 22:16:48 +0000 (UTC)
Complaints-To: groups-abuse@google.com
Injection-Info: c1g2000vbw.googlegroups.com; posting-host=24.218.138.255;
 posting-account=ShYTIAoAAABytvcS76ZrG9GdaV-nXYKy
User-Agent: G2/1.0
X-Google-Web-Client: true
X-Google-Header-Order: ARLUEHNKC
X-HTTP-UserAgent: Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0;
 Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR
 3.5.30729; .NET CLR 3.0.30729; .NET4.0C; InfoPath.2),gzip(gfe)
Xref: news2.google.com comp.lang.ada:14300
Content-Type: text/plain; charset=ISO-8859-1
Date: 2011-11-03T15:01:06-07:00
List-Id: <comp.lang.ada>


I am attempting to create a limited, private, controlled type that
extends an interface type via an allocator (i think that's the right
termonology) with GNAT (GNATMAKE GPL 2011 20110428), but not having
much luck.  To summarize, when the access type is that of the concrete
type, or if the type is made non-limited, everything works as it
should.  However, when the access type is of the classwide variety and
the type is limited, things go bananas in a way that I cannot just
wrap my head around.

I'm not sure if I'm misusing the limited nature, the extended return
syntax, or the classwide type, but I have had no success unravelling
the mystery.  If anybody can point out where I've gone off the rails,
and also the appropriate part of the RM that i've missed, I would be
eternally grateful.

The entire sample program is at the bottom, but here is the basic
jist:

When the access type is defined as:

type Foo_Ptr is access all P.Foo_Type;

the execution performs as expected:

Entered Create
Entered Initialize
Entered Extended Return
Leaving Extended Return
Starting...
Entered Doo!
Ending...
Entered Finalize
[2011-11-03 17:38:57] process terminated successfully (elapsed time:
00.12s)

When the access type is changed to:

type Foo_Ptr is access all I.LI'Class;

the output crashes to some strange function that indicates it should
be impossible to ever get to (hence my confusion):

Entered Create
Entered Initialize
Entered Extended Return
Leaving Extended Return
Starting...
Entered Finalize

raised PROGRAM_ERROR : s-finroo.adb:42 explicit raise
[2011-11-03 17:40:27] process exited with status 1 (elapsed time:
00.13s)


The sample code is as follows:

with Ada.Text_IO;
with Ada.Finalization;

procedure Test_Init is

   -- An interface with one function Doo
   package I is
      type LI is limited interface;
      procedure Doo (This : LI) is abstract;
   end I;

   -- Concrete, limited, controlled implementation
   package P is
      type Foo_Type is limited new Ada.Finalization.Limited_Controlled
and I.LI with
         record
            o : Integer;
         end record;

      function Create (Arg : in Integer) return Foo_Type;
      overriding procedure Initialize (This : in out Foo_Type);
      overriding procedure Finalize   (This : in out Foo_Type);
      overriding procedure Doo (This :  Foo_Type);
    end P;

   package body P is

      function Create (Arg : in Integer) return Foo_Type is
      begin
         Ada.Text_IO.Put_Line("Entered Create");
         return Object : Foo_Type do
            Ada.Text_IO.Put_Line("Entered Extended Return");
            Object.o := Arg;
            Ada.Text_IO.Put_Line("Leaving Extended Return");
         end return;
      end Create;

      overriding procedure Initialize (This : in out Foo_Type) is
      begin
         Ada.Text_IO.Put_Line("Entered Initialize");
      end Initialize;

      overriding procedure Finalize   (This : in out Foo_Type) is
      begin
         Ada.Text_IO.Put_Line("Entered Finalize");
      end Finalize;

      overriding procedure Doo (This : Foo_Type) is
      begin
         Ada.Text_IO.Put_Line("Entered Doo!");
      end Doo;

   end P;

--      type Foo_Ptr is access P.Foo_Type;  -- Output A
--      type Foo_Ptr is access I.LI'Class;  -- Output B


   Bar : Foo_Ptr := new P.Foo_Type'(P.Create(42));

begin

   Ada.Text_IO.Put_Line("Starting...");
   Bar.all.Doo;
   Ada.Text_IO.Put_Line("Ending...");

end Test_Init;


Thank you in advance to anyone who can explain what exactly is going
on here.

-sb