TEAM-ADA Archives

Team Ada: Ada Programming Language Advocacy

TEAM-ADA@LISTSERV.ACM.ORG

Options: Use Forum View

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

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

Print Reply
Subject:
From:
Christoph & Ursula Grein <[log in to unmask]>
Reply To:
Christoph & Ursula Grein <[log in to unmask]>
Date:
Sun, 20 Jul 1997 15:57:00 +0100
Content-Type:
text/plain
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;

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]

ATOM RSS1 RSS2