with Ada.Finalization;

generic

  type Uncontrolled (<>) is abstract tagged private;

--with procedure Initialize (Object: in out Uncontrolled);
  with procedure Adjust     (Object: in out Uncontrolled);
  with procedure Finalize   (Object: in out Uncontrolled);

package Add_Finalization.To_Uncontrolled 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'Unrestricted_Access);  -- Gnat only
  end record;

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

end Add_Finalization.To_Uncontrolled;

with Ada.Task_Attributes;

package body Add_Finalization.To_Uncontrolled 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;
    Adjust (Uncontrolled (Object.Parent.all));
  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.To_Uncontrolled;

Back to text.
Zurück zum Text.