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,start X-Google-Attributes: gid103376,public X-Google-Language: ENGLISH,ASCII-7-bit Path: g2news2.google.com!postnews.google.com!h54g2000cwb.googlegroups.com!not-for-mail From: "Michael Rohan" Newsgroups: comp.lang.ada Subject: Deallocating list of polymorphic objects? Date: 30 Nov 2006 15:40:27 -0800 Organization: http://groups.google.com Message-ID: <1164930027.758923.119740@h54g2000cwb.googlegroups.com> NNTP-Posting-Host: 148.87.1.170 Mime-Version: 1.0 Content-Type: text/plain; charset="iso-8859-1" X-Trace: posting.google.com 1164930040 14275 127.0.0.1 (30 Nov 2006 23:40:40 GMT) X-Complaints-To: groups-abuse@google.com NNTP-Posting-Date: Thu, 30 Nov 2006 23:40:40 +0000 (UTC) User-Agent: G2/1.0 X-HTTP-UserAgent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8.0.8) Gecko/20061107 Fedora/1.5.0.8-1.fc6 Firefox/1.5.0.8 pango-text,gzip(gfe),gzip(gfe) Complaints-To: groups-abuse@google.com Injection-Info: h54g2000cwb.googlegroups.com; posting-host=148.87.1.170; posting-account=gAOdzgwAAACn-YRtA_sS8eamp4mn5Zlu Xref: g2news2.google.com comp.lang.ada:7762 Date: 2006-11-30T15:40:27-08:00 List-Id: Hi Folks, 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. Since I want the deallocation to be dispatching, it needs to take an access parameter which is then converted to a pointer for the object being deallocated, e.g., an Integer_Pointer, and then passed to an Unchecked_Deallocation procedure. The code below (formatted to minimize the size of this posting) does what I expect: $ gnatmake -gnat05 list_test gcc -c -gnat05 list_test.adb gcc -c -gnat05 lists.adb gnatbind -x list_test.ali gnatlink list_test.ali $ ./list_test Finalizing a list Integer object: 1 Float object: -1.00000E+00 Integer object: 2 Float object: -2.00000E+00 However, I have a feeling there is something "bad" about this type of deallocation, probably related to storage pool but I'm not familiar enough with storage pools to be sure. Would anyone care to comment on how safe/unsafe this deallocation scheme is? Take care, Michael --- list_test.adb --------------------------------------------------------------------------- with Lists; procedure List_Test is L : Lists.List_Type; begin Lists.Append (L, 1); Lists.Append (L, -1.0); Lists.Append (L, 2); Lists.Append (L, -2.0); end List_Test; --- lists.ads --------------------------------------------------------------------------- with Ada.Finalization; with Ada.Containers.Vectors; package Lists is type List_Type is limited private; procedure Append (L : in out List_Type; I : Integer); procedure Append (L : in out List_Type; F : Float); private type Object is abstract tagged null record; type Object_Pointer is access all Object'Class; procedure Print (Pointer : access Object) is abstract; procedure Deallocate (Pointer : access Object) is abstract; package List_Vector_Package is new Ada.Containers.Vectors (Index_Type => Natural, Element_Type => Object_Pointer); type List_Type is new Ada.Finalization.Limited_Controlled with record Contents : List_Vector_Package.Vector; end record; overriding procedure Finalize (L : in out List_Type); end Lists; --- lists.adb --------------------------------------------------------------------------- with Ada.Text_IO; with Ada.Unchecked_Deallocation; package body Lists is use Ada.Containers; use List_Vector_Package; package Integer_Objects is type Integer_Object is new Object with record I : Integer; end record; overriding procedure Print (Pointer : access Integer_Object); overriding procedure Deallocate (Pointer : access Integer_Object); end Integer_Objects; package Float_Objects is type Float_Object is new Object with record F : Float; end record; overriding procedure Print (Pointer : access Float_Object); overriding procedure Deallocate (Pointer : access Float_Object); end Float_Objects; use Float_Objects; use Integer_Objects; package body Integer_Objects is type Integer_Pointer is access all Integer_Object; procedure Free is new Ada.Unchecked_Deallocation (Integer_Object, Integer_Pointer); procedure Print (Pointer : access Integer_Object) is begin Ada.Text_IO.Put_Line ("Integer object: " & Pointer.I'Img); end Print; procedure Deallocate (Pointer : access Integer_Object) is I_Pointer : Integer_Pointer := Integer_Pointer (Pointer); begin Print (Pointer); Free (I_Pointer); end Deallocate; end Integer_Objects; package body Float_Objects is type Float_Pointer is access all Float_Object; procedure Free is new Ada.Unchecked_Deallocation (Float_Object, Float_Pointer); procedure Print (Pointer : access Float_Object) is begin Ada.Text_IO.Put_Line ("Float object: " & Pointer.F'Img); end Print; procedure Deallocate (Pointer : access Float_Object) is I_Pointer : Float_Pointer := Float_Pointer (Pointer); begin Print (Pointer); Free (I_Pointer); end Deallocate; end Float_Objects; procedure Append (L : in out List_Type; I : Integer) is begin Append (L.Contents, new Integer_Object'(I => I)); end Append; procedure Append (L : in out List_Type; F : Float) is begin Append (L.Contents, new Float_Object'(F => F)); end Append; procedure Finalize (L : in out List_Type) is Pointer : Object_Pointer; begin Ada.Text_IO.Put_Line ("Finalizing a list"); if L.Contents.Length > 0 then for I in 0 .. Integer (L.Contents.Length - 1) loop Pointer := Element (L.Contents, I); Deallocate (Pointer); end loop; end if; end Finalize; end Lists;