Creation of controlled type will call finalize on return

Question

I want to create a function for creating and initializing a controlled type (a bit like a factory) in the following manner:

function Create return Controlled_Type
is
  Foo : Controlled_Type;
begin
   Put_Line ("Check 1")
   return Foo;
end Create;

procedure Main
is
  Bar : Controlled_Type := Create;
begin
  Put_Line ("Check 2")
end Main;

output:
Initialize
Check 1
Adjust
Finalize

As the finalize will dispose of some objects that are pointed to in the controlled type I end up with dangling pointers in Bar, and somehow this immediately crashes the program, so I never see "Check 2".

This can easily be resolved by using new Controlled_Type and returning a pointer in the Create function. However, I like the idea of having the controlled type and not a pointer to it as finalization will automatically be called when Bar goes out of scope. If Bar was a pointer, I'd have to manually dispose of it.

Is there any way to do this properly without ending up with dangling pointers? Should I do some magic in the Adjust procedure?

Answer 1

Well, you should implement Adjust appropriately!

When you make a copy, it’s bitwise, so any pointer in the original is copied as-is to the copy. When the original is finalized and the pointed-to object is deallocated, you’re left with a pointer-to-hyperspace in the copy.

The thing to do is to allocate a new pointer, designating the same value as the original. Something like

with Ada.Finalization;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Deallocation;

procedure Finalart is

   type Integer_P is access Integer;
   type Controlled_Type is new Ada.Finalization.Controlled with record
      P : Integer_P;
   end record;
   procedure Initialize (This : in out Controlled_Type);
   procedure Adjust (This : in out Controlled_Type);
   procedure Finalize (This : in out Controlled_Type);

   procedure Initialize (This : in out Controlled_Type) is
   begin
      Put_Line ("initialize");
      This.P := new Integer'(42);
   end Initialize;

   procedure Adjust (This : in out Controlled_Type) is
      Original_Value : constant Integer := This.P.all;
   begin
      Put_Line ("adjust");
      This.P := new Integer'(Original_Value);
   end Adjust;

   procedure Finalize (This : in out Controlled_Type) is
      procedure Free is new Ada.Unchecked_Deallocation (Integer, Integer_P);
   begin
      Put_Line ("finalize");
      Free (This.P);
   end Finalize;

   function Create return Controlled_Type is
      CT : Controlled_Type;
   begin
      Put_Line ("check 1");
      return CT;
   end Create;

   Bar : Controlled_Type := Create;
begin
   Put_Line ("check 2");
end Finalart;

If I comment out the line This.P := new Integer'(Original_Value); in Adjust, I get (on macOS)

$ ./finalart 
initialize
check 1
adjust
finalize
adjust
finalize
finalart(35828,0x7fffd0f8b3c0) malloc: *** error for object 0x7fca61500000: pointer being freed was not allocated
*** set a breakpoint in malloc_error_break to debug

raised PROGRAM_ERROR : unhandled signal