Excuse me if you receive this twice. I posted this on 20th July, but have some
doubt that it was sent. T-Online.de 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
saved).

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;

generic

  type Uncontrolled (<>) is abstract tagged private;

  with procedure Finalize (Object: in out Uncontrolled);

package Add_Finalization is

  type Controlled is new Uncontrolled with private;

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
                              Controlled'Unchecked_Access);
  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
  begin
    Object.Parent := Store.Value;
  end Adjust;

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

end Add_Finalization;


Christoph Grein
[log in to unmask]