factoryadadangling-pointerfinalization

Creation of controlled type will call finalize on return


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?


Solution

  • 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