Re: Destructor question

[david.c.hoos.sr@ada95.com]

In article <3665B85D.A2663591@nowhere.com>,
  Rusnak <bogus@nowhere.com> wrote:
> How are destrcutor methords properly implemented in Ada on tagged
> records?  I have the following setup:
<snip>

Here is my solution to the problem, based on Robert Eachus's post to this
thread.

I do, however, find some points of Robert's posting at variance with what I
was able to make work, viz.:

    1.  Robert said "Next, you need, and this need not be visible, to have a
        two parameter version that is dispatching on Object"  I do not see how
        this can be made invisible, since it needs to be a primitive operation
        of the type.  Perhaps someone can enlightne me on this.

    2.  Robert said "Note that the parameter "The_Object" is never used, it is
        just there to get the dispatching."  This would be true if it were not
        for your requirement that you be able to deallocate internal
        dynamically-allocated components.

At any rate, here is a sample program which is a complete and working
implementation of Robert's ideas.  I hope it helps.  The exercise certainly
clarified the solution for me.

David C. Hoos, Sr.

with Ada.Tags;
with Ada.Text_Io;
with Ada.Unchecked_Deallocation;
procedure Test_Rusnak is

   package Rusnak is

      type Instance is abstract tagged null record;

      type Object_Class is access all Instance'Class;

      -- This procedure can never be called, since no instance of an
      -- abstract type can exist, but it must exist, otherwise the
      -- single-parameter Deallocate will not compile.
      procedure Deallocate
        (The_Access : in out Object_Class;
         The_Object : in out Instance);

      -- This is the class-wide deallocation procedure which is called to
      -- deallocate any objet of a type derived from Instance.  It makes a
      -- dispatching call to the appropriate two-parameter Deallocate
      -- procedure which must be a primitive operation for all types derived
      -- from Instance.
      procedure Deallocate (The_Access : in out Object_Class);

      -- This is the type of a component of type Derived.
      type String_Access is access all String;

      -- This type is an example of a concrete type derived from Instance
      -- which has internal dynamically-allocated objects which need to be
      -- deallocated when an object of the type is deallocated.
      type Derived is new Instance with record
         Data_Access: String_Access;
      end record;

      -- This is the two-parameter Deallocate procedure, a primitive operation
      -- of type Derived.  It must be declared at this point -- i.e. before
      -- Derived is frozen.
      procedure Deallocate
        (The_Access : in out Object_Class;
         The_Object : in out Derived);

   end Rusnak;

   package body Rusnak is

      procedure Deallocate
        (The_Access : in out Object_Class;
         The_Object : in out instance) is
      begin
         null;
      end Deallocate;

      -- This type serves only to provide the required parameter type for an
      -- instantiation of Ada.Unchecked_Deallocation.  It must be decalred
      -- here instead of inside the Deallocate procedure, in order that it
      -- have the same access level as the type which it accesses.
      type Derived_Class is access all Derived;

  -- This procedure is declared outside the Deallocate procedure from which 
-- it is called, only because it is for a type which would likely be used  --
for components of more than one type derived from Instance.  procedure Free
is new Ada.Unchecked_Deallocation  (Object => string,  Name =>
String_access);

      procedure Deallocate
        (The_Access : in out Object_Class;
         The_Object : in out Derived) is
         procedure Free is new Ada.Unchecked_Deallocation
           (Object => derived,
            Name => derived_Class);
      begin
         Ada.Text_Io.Put_Line ("Deallocating ""derived"" object");
         Free (The_Object.Data_Access);
         Free (Derived_Class (The_Access));
      end Deallocate;

      procedure Deallocate (The_Access : in out Object_Class) is
      begin
         Ada.Text_Io.Put_Line
           ("Dispatching to deallocator for concrete type """ &
            Ada.Tags.External_Tag (The_Access.all'Tag) & """.");
         Deallocate (The_Access => The_Access, The_Object => The_Access.all);
      end Deallocate;

   end Rusnak;

   The_Derived_Object_access : Rusnak.Object_class :=
    new Rusnak.Derived'(Data_Access => new String'("this is the data"));

begin

   Ada.Text_Io.Put_Line
     (Rusnak.Derived (The_Derived_Object_Access.all).Data_Access.all);
   Rusnak.Deallocate (The_Derived_Object_Access);
   Ada.Text_Io.Put_Line("The next statement will raise Constraint_Error");
   Ada.Text_Io.Put_Line
     (Rusnak.Derived (The_Derived_Object_Access.all).Data_Access.all);

end Test_Rusnak;



-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/       Search, Read, Discuss, or Start Your Own