TEAM-ADA Archives

Team Ada: Ada Programming Language Advocacy


Options: Use Classic View

Use Proportional Font
Show Text Part by Default
Condense Mail Headers

Topic: [<< First] [< Prev] [Next >] [Last >>]

Print Reply
Sender: "Team Ada: Ada Advocacy Issues (83 & 95)" <[log in to unmask]>
From: Christoph & Ursula Grein <[log in to unmask]>
Date: Sun, 20 Jul 1997 15:57:00 +0100
Reply-To: Christoph & Ursula Grein <[log in to unmask]>
Parts/Attachments: text/plain (66 lines)
What do you think of the following solution?

It has a clean and simple interface, and each task has its own copy of the
store (attribute).
With the implementation permission of RM C.7.2, tasks that do not use the type
hierarchy need not even store the attribute.

Are there any flaws? (I'm just fishing for compliments.)

with Ada.Finalization;


  type Uncontrolled (<>) is abstract tagged private;

  with procedure Finalize (Object: in out Uncontrolled);

package Add_Finalization is

  type Controlled is new Uncontrolled with private;


  type Controlled_Ptr is access all Controlled;

  type Component is new Ada.Finalization.Controlled with record
    Parent: Controlled_Ptr;
  end record;

  type Controlled is new Uncontrolled with record
    Controller: Component := (Ada.Finalization.Controlled with
  end record;

  procedure Adjust   (Object: in out Component);
  procedure Finalize (Object: in out Component);

end Add_Finalization;

with Ada.Task_Attributes;

package body Add_Finalization is

  package Store is new Ada.Task_Attributes (Attribute     => Controlled_Ptr,
                                            Initial_Value => null);

  procedure Adjust (Object: in out Component) is
    Object.Parent := Store.Value;
  end Adjust;

  procedure Finalize (Object: in out Component) is
    Store.Set_Value (Object.Parent);
    Finalize (Uncontrolled (Object.Parent.all));
  end Finalize;

end Add_Finalization;

Christoph Grein
[log in to unmask]