TEAM-ADA Archives

Team Ada: Ada Programming Language Advocacy


Options: Use Classic View

Use Proportional Font
Show Text Part by Default
Show All Mail Headers

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

Print Reply
Christoph & Ursula Grein <[log in to unmask]>
Mon, 28 Jul 1997 11:24:14 -0400
text/plain (77 lines)
Excuse me if you receive this twice. I posted this on 20th July, but have some
doubt that it was sent. is having big problems these days ...
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 (although, for an access value,
in my feeling no compiler would use the permission because the code to
dynamically create and destroy the attribute would take more memory than is

Are there any flaws? (I'm just fishing for compliments.)
Seriously, I'm interested in a response.
No need to use limited types (of the Goodenough kind, whatever this may be)
as Robert Eachus proposes or to reconstruct the type hierarchy to include
controlledness from the beginning as Heath White did - IF your compiler
complies to annex C ELSE the old mess persists END IF.

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]