comp.lang.ada
 help / color / mirror / Atom feed
From: Simon Belmont <sbelmont700@gmail.com>
Subject: limited allocated classwide types
Date: Thu, 3 Nov 2011 15:01:06 -0700 (PDT)
Date: 2011-11-03T15:01:06-07:00	[thread overview]
Message-ID: <0ed43f83-40e7-46d3-8cc4-e1c41f500d28@c1g2000vbw.googlegroups.com> (raw)


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



             reply	other threads:[~2011-11-03 22:16 UTC|newest]

Thread overview: 19+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2011-11-03 22:01 Simon Belmont [this message]
2011-11-03 22:50 ` limited allocated classwide types Adam Beneschan
2011-11-03 23:14 ` Simon Wright
2011-11-03 23:35   ` Simon Belmont
2011-11-04  0:30     ` Adam Beneschan
2011-11-04  0:51       ` Adam Beneschan
2011-11-04  7:40     ` Simon Wright
2011-11-04  8:42       ` Dmitry A. Kazakov
2011-11-04  9:18     ` Georg Bauhaus
2011-11-04  9:53     ` Brian Drummond
2011-11-04 16:39       ` Simon Wright
2011-11-04 18:47       ` Adam Beneschan
2011-11-04 20:03         ` Simon Wright
2011-11-08  4:25         ` Randy Brukardt
2011-11-08 12:10           ` Brian Drummond
2011-11-08 12:35             ` Simon Wright
2011-11-08 13:05               ` Dmitry A. Kazakov
2011-11-10  9:56             ` Álex R. Mosteo
2011-11-04 12:25 ` Stephen Leake
replies disabled

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox