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=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Thread: 103376,97a4ff0c3103bbb6
X-Google-Attributes: gid103376,public
X-Google-Language: ENGLISH,ASCII-7-bit
Path: 
 g2news2.google.com!news3.google.com!news1.google.com!news.maxwell.syr.edu!elnk-pas-nf1!newsfeed.earthlink.net!stamper.news.pas.earthlink.net!newsread3.news.pas.earthlink.net.POSTED!14bb18d8!not-for-mail
Sender: Matthew Heaney@MHEANEYIBMT43
Newsgroups: comp.lang.ada
Subject: Re: Deallocating list of polymorphic objects?
References: <1164930027.758923.119740@h54g2000cwb.googlegroups.com>
From: Matthew Heaney <matthewjheaney@earthlink.net>
Message-ID: <uu00gcl1o.fsf@earthlink.net>
User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.3
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Date: Fri, 01 Dec 2006 04:11:34 GMT
NNTP-Posting-Host: 24.149.57.125
X-Complaints-To: abuse@earthlink.net
X-Trace: newsread3.news.pas.earthlink.net 1164946294 24.149.57.125 (Thu,
 30 Nov 2006 20:11:34 PST)
NNTP-Posting-Date: Thu, 30 Nov 2006 20:11:34 PST
Organization: EarthLink Inc. -- http://www.EarthLink.net
Xref: g2news2.google.com comp.lang.ada:7767
Date: 2006-12-01T04:11:34+00:00
List-Id: <comp.lang.ada>

"Michael Rohan" <mrohan@ACM.ORG> writes:

> I would like to construct a list of polymorphic objects that,
> as part of the list's finalization, deallocates the objects on
> the list.  Basically, I have a vector of pointers to Object'Class.
> The objects are added to the list via procedures defined for
> the list, e.g., append an integer, append a floating point.
> These append procedures allocate objects derived from the
> base Object type for the type being appended, e.g.,
> Integer_Object, which is private to the list package.


Here's one way to do it:

--STX
with Ada.Containers.Indefinite_Vectors;
pragma Elaborate_All (Ada.Containers.Indefinite_Vectors);

package Lists is

   type List_Type is tagged limited private;

   procedure Append (L : in out List_Type; I : Integer);
   procedure Append (L : in out List_Type; F : Float);

private

   type Object is interface;
   procedure Print (O : Object) is abstract;

   package List_Vectors is
      new Ada.Containers.Indefinite_Vectors (Natural, Object'Class);

   type List_Type is tagged limited record
      V : List_Vectors.Vector;
   end record;


   type Integer_Object is new Object with record
      I : Integer;
   end record;

   procedure Print (O : Integer_Object);

   type Float_Object is new Object with record
      F : Float;
   end record;

   procedure Print (O : Float_Object);

end Lists;


package body Lists is

   procedure Append (L : in out List_Type; I : Integer) is
   begin
      L.V.Append (Integer_Object'(I => I));
   end;

   procedure Append (L : in out List_Type; F : Float) is
   begin
      L.V.Append (Float_Object'(F => F));
   end;

   procedure Print (O : Integer_Object) is
   begin
      null;
   end;

   procedure Print (O : Float_Object) is
   begin
      null;
   end;

end Lists;