How can I do an unchecked_deallocation of abstract classes in Ada?

Question

I know Ada quite well but I‘m still struggling with OO in general and specifically in Ada. Thus, it may well be that I‘m simply missing a point.

Consider a data structure like a tree. The objects stored in the tree are of abstract type. I want full control over the deallocation (with Ada.Finalization) because I’m implementing the data structure with safe pointers. This means that on deallocation of the tree, subtrees must not be deallocated when there is still a reference to it.

In this scenario it is required to deallocate the concrete objects referenced in the data structure. It seems to me that this requires an abstract unchecked_deallocation. Is there a simple way to do this? I also considered declaring an abstract Free subroutine that has to be implemented by the instances of the abstract type. Unsuccessful.

In didn’t checked the standard libraries yet for a suitable data structure. Currently I’m just curious about the problem itself.

Answer 1

This was entertaining on a rainy Sunday morning!

The basic trick is to use Foo’Class for the type to be deallocated, and access Foo’Class for the access type.

generic
   type T is abstract tagged private;
   type T_Access is access T'CLass;
package Abstract_Deallocation is
   type Holder is private;

   function Is_Empty (H : Holder) return Boolean;

   procedure Add (To : in out Holder; Item : T_Access);

   procedure Release (H : in out Holder)
   with Post => Is_Empty (H);
private
   type Holder is new T_Access;

   function Is_Empty (H : Holder) return Boolean
   is (H = null);
end Abstract_Deallocation;

with Ada.Unchecked_Deallocation;
package body Abstract_Deallocation is
   procedure Free is new Ada.Unchecked_Deallocation
     (T'Class, T_Access);

   procedure Add (To : in out Holder; Item : T_Access) is
   begin
      To := Holder (Item);
   end Add;

   procedure Release (H : in out Holder) is
   begin
      Free (T_Access (H));
   end Release;
end Abstract_Deallocation;

with Abstract_Deallocation;
procedure Abstract_Deallocation_Test is
   type Actual_T is abstract tagged null record;
   type Actual_T_Access is access all Actual_T'Class;

   package Demo is new Abstract_Deallocation
     (T        => Actual_T,
      T_Access => Actual_T_Access);

   type Concrete_T is new Actual_T with null record;
   Holder : Demo.Holder;
begin
   Demo.Add (Holder, new Concrete_T);
   Demo.Release (Holder);
end Abstract_Deallocation_Test;