Avoiding nested try...finally blocks in Delphi

Question

I had this idea this morning on avoiding nested try finally blocks like the following

procedure DoSomething;
var
  T1, T2, T3 : TTestObject;
begin
  T1 := TTestObject.Create('One');
  try
    T2 := TTestObject.Create('Two');
    try
      T3 := TTestObject.Create('Three');
      try
        //A bunch of code;
      finally
        T3.Free;
      end;
    finally
      T2.Free;
    end;
  finally
    T1.Free;
  end;
end;

By taking advantage of the automated reference counting of interfaces, I have come up with

Type  
  IDoFinally = interface
    procedure DoFree(O : TObject);
  end;

  TDoFinally = class(TInterfacedObject, IDoFinally)
  private
    FreeObjectList : TObjectList;
  public
    procedure DoFree(O : TObject);
    constructor Create;
    destructor Destroy; override;
  end;

//...

procedure TDoFinally.DoFree(O : TObject);
begin
  FreeObjectList.Add(O);
end;

constructor TDoFinally.Create;
begin
  FreeObjectList := TObjectList.Create(True);
end;

destructor TDoFinally.Destroy;
begin
  FreeObjectList.Free;
  inherited;
end;

So that the previous block of code becomes

procedure DoSomething;
var
  T1, T2, T3 : TTestObject;
  DoFinally : IDoFinally;
begin
  DoFinally := TDoFinally.Create;
  T1 := TTestObject.Create('One');
  DoFinally.DoFree(T1);
  T2 := TTestObject.Create('Two');
  DoFinally.DoFree(T2);
  T3 := TTestObject.Create('Three');
  DoFinally.DoFree(T3);
  // A Bunch of code;
end;

My question is: does this work or have I overlooked something?

To me this looks pretty cool, and makes the code a bit easier to read with the reduced amount of nesting. It could also be extended to store a list of anonymous methods to run to do things such as close files, queries, etc...

Answer 1

Yes, it works.

Perhaps the only thing different between the nested try-finally blocks of the original code and the technique of using a reference-counted object to manage the lifetimes of other objects is what happens if there's a problem destroying any of the objects. If there's an exception while any object is being destroyed, the nested try-finally blocks will ensure that any remaining objects will still get freed. The TObjectList in your TDoFinally doesn't do that; if any item in the list can't be destroyed, any subsequent items in the list will be leaked.

In practice, that's not really a problem, though. No destructor should ever throw an exception. If it does, there's not really any way to recover from it anyway, so it doesn't matter if anything leaks because of it. Your program should terminate momentarily anyway, so having a tidy cleanup routine is of little importance.

Incidentally, the JCL already offers the ISafeGuard and IMultiSafeGuard interfaces for managing local objects' lifetimes. For example, you could rewrite your code like this:

uses JclSysUtils;

procedure DoSomething;
var
  T1, T2, T3: TTestObject;
  G: IMultiSafeGuard;
begin
  T1 := TTestObject(Guard(TTestObject.Create('One'), G));
  T2 := TTestObject(Guard(TTestObject.Create('Two'), G));
  T3 := TTestObject(Guard(TTestObject.Create('Three'), G));
  // A Bunch of code;
end;

That library doesn't address exceptions in destructors, either.

Answer 2

I usually do something like this, as provides a balance between code readability and complexity:

procedure DoSomething;
var
  T1, T2, T3 : TTestObject;
begin
  T1 := nil;
  T2 := nil;
  T3 := nil;
  try
    T1 := TTestObject.Create('One');
    T2 := TTestObject.Create('Two');
    T3 := TTestObject.Create('Three');

    // A bunch of code

  finally
    T3.Free;
    T2.Free;
    T1.Free;
  end;
end;

Warning:

• This is not completely equivalent to your original code, because if T3.Free throws an exception, T2 and T1 will not get freed and cause a memory leak, and the same for T2.Free in respect of T1.

• However, as Rob Kennedy points in his comment, and explain in more detail in his answer, it is equivalent to your alternative code using IDoFinally.

• So your two approaches are not completely equivalent.

Answer 3

Smart pointers are other way to achieve automatic memory management.

The ADUG website has an Delphi implementation derived from Barry Kelly's articles on how to implement strongly-typed smart pointers in Delphi using generics, anonymous methods and interfaces:

1. Smart pointers in Delphi
2. Reference-counted pointers, revisited
3. Somewhat more efficient smart pointers

Your code will be rewritten as this:

procedure DoSomething;
var
  T1, T2, T3 : ISmartPointer<TTestObject>;
begin
  T1 := TSmartPointer<TTestObject>.Create(TTestObject.Create('One'));
  T2 := TSmartPointer<TTestObject>.Create(TTestObject.Create('Two'));
  T3 := TSmartPointer<TTestObject>.Create(TTestObject.Create('Three'));

  // A bunch of code
end;

Answer 4

I have a set of helper functions to make @JRL's approach more digestible.

procedure InitialiseNil(var Obj1); overload;
procedure InitialiseNil(var Obj1, Obj2); overload;
procedure InitialiseNil(var Obj1, Obj2, Obj3); overload;

procedure FreeAndNil(var Obj1); overload;
procedure FreeAndNil(var Obj1, Obj2); overload;
procedure FreeAndNil(var Obj1, Obj2, Obj3); overload;

In fact my code has versions with even more parameters. For ease of maintenance this code is all automatically generated from a short Python script.

These methods are implemented in the obvious way, e.g.

procedure FreeAndNil(var Obj1, Obj2);
var
  Temp1, Temp2: TObject;
begin
  Temp1 := TObject(Obj1);
  Temp2 := TObject(Obj2);
  Pointer(Obj1) := nil;
  Pointer(Obj2) := nil;
  Temp1.Free;
  Temp2.Free;
end;

This allows us to re-write the code in the question like this:

InitialiseNil(T1, T2, T3);
try
  T1 := TTestObject.Create('One');
  T2 := TTestObject.Create('Two');
  T3 := TTestObject.Create('Three');
finally
  FreeAndNil(T3, T2, T1);
end;

And the Python script:

count = 8


def VarList(count, prefix):
    s = ""
    for i in range(count):
        if i != 0:
            s = s + ", "
        s = s + prefix + str(i + 1)
    return s


def InitialiseNilIntf(count):
    print("procedure InitialiseNil(var " + VarList(count, "Obj") + "); overload;")


def FreeAndNilIntf(count):
    print("procedure FreeAndNil(var " + VarList(count, "Obj") + "); overload;")


def InitialiseNilImpl(count):
    print("procedure InitialiseNil(var " + VarList(count, "Obj") + ");")
    print("begin")
    for i in range(count):
        print("  Pointer(Obj%s) := nil;" % str(i + 1))
    print("end;")
    print()


def FreeAndNilImpl(count):
    print("procedure FreeAndNil(var " + VarList(count, "Obj") + ");")
    print("var")
    print("  " + VarList(count, "Temp") + ": TObject;")
    print("begin")
    for i in range(count):
        print("  Temp%s := TObject(Obj%s);" % (str(i + 1), str(i + 1)))
    for i in range(count):
        print("  Pointer(Obj%s) := nil;" % str(i + 1))
    for i in range(count):
        print("  Temp%s.Free;" % str(i + 1))
    print("end;")
    print()


for i in range(count):
    InitialiseNilIntf(i + 1)
print()
for i in range(count):
    FreeAndNilIntf(i + 1)
print()
for i in range(count):
    InitialiseNilImpl(i + 1)
print()
for i in range(count):
    FreeAndNilImpl(i + 1)

Answer 5

An alternative I sometimes use:

procedure DoSomething;
var
  T1, T2, T3: TTestObject;
begin
  T1 := nil;
  T2 := nil;
  T3 := nil;
  try
    T1 := TTestObject.Create;
    T2 := TTestObject.Create;
    T3 := TTestObject.Create;
    // ...
  finally
    T1.Free;
    T2.Free;
    T3.Free;
  end;
end;

Answer 6

Yes, this code works, although I would personally be inclined to add inherited to your constructor and destructor.

There are many libraries out there that have implementations that use this mechanism. The latest Delphi compilers for mobile platforms manage object lifetimes using ARC, automated reference counting, which is the same technique but baked into the compiler's treatment of object references.

Answer 7

Here's a slightly different implementation of the same idea:

unit ObjectGuard;

interface

type
  TObjectReference = ^TObject;

  { TObjectGuard }
  TObjectGuard = class(TInterfacedObject)
  private
    fUsed: integer;
    fObjectVariable: array [0..9] of TObjectReference;
  public
    constructor Create(var v0); overload;
    constructor Create(var v0, v1); overload;
// add overloaded constructors for 3,4,5... variables
    destructor Destroy; override;
  end;

implementation

constructor TObjectGuard.Create(var v0);
begin
  fObjectVariable[0] := @TObject(v0);
  Tobject(v0) := nil;
  fUsed := 1;
end;

constructor TObjectGuard.Create(var v0, v1);
begin
  fObjectVariable[0] := @TObject(v0);
  Tobject(v0) := nil;
  fObjectVariable[1] := @TObject(v1);
  Tobject(v1) := nil;
  fUsed := 2;
end;

destructor TObjectGuard.Destroy;
var
  i: integer;
begin
  for i := 0 to FUsed - 1 do
    if Assigned(fObjectVariable[i]^) then
    begin
      fObjectVariable[i]^.Free;
      fObjectVariable[i]^ := nil;
    end;
  inherited;
end;

end.

The advantage being the simple usage, such as:

procedure Test;
var
  Guard: IInterface
  vStringList: TStringList;
  vForm: TForm;
begin
  Guard := TObjectGuard.Create(vStringList, vForm);
  vStringList := TStringList.Create;
  vForm:= TForm.Create(nil);
  // code that does something
end;

It's convenient that you can create the Guard at the beginning of the method and pass any number of Variables in one call. So you don't have to first create object instances.

Also notice the variables will automatically be initialised to nil in the Constructor.

Edit: Also, due to the fact that interface lifetime is equal to the execution time of the method, we can use that for profiling, perhaps IFDEF-ed for easier control.

Answer 8

It's tricky to understand which method to use based on the end purpose, but in some cases, this is where I tend to implement subroutines, or in general separate my code into different functions. For example...

FOne: TSomeObject;
FTwo: TSomeObject;
FThree: TSomeObject;

....

procedure DoSomething;
begin
  FOne:= TSomeObject.Create;
  try
    //a bunch of code which only needs FOne
    DoSomethingElse;
  finally
    FOne.Free;
  end;
end;

procedure DoSomethingElse;
begin
  FTwo:= TSomeObject.Create;
  try
    ShowMessage(DoYetAnother);
    //A bunch of code that requires FTwo
  finally
    FTwo.Free;
  end;
end;

function DoYetAnother: String;
begin
  FThree:= TSomeObject.Create;
  try
    //Do something with FOne, FTwo, and FThree
    Result:= FOne.Something + FTwo.Something + FThree.Something;
  finally
    FThree.Free;
  end;
end;

Again, it's difficult for you to understand how this would work without a more real-life scenario. I'm still thinking for a good example and will gladly edit when I think of one. The general idea though is separating different segments of business rule into different re-usable blocks of code.

Alternatively, rather than declaring global variables, you could also pass parameters from one procedure to the next.

Answer 9

I don't see the need to wrap the destructor in an interface. By default, Delphi builds a behind-the-scene try/finally into each procedure/function that uses interfaces, in which the reference count of the interfaces are decreased, thus calling the destructor when it reaches zero.

I had a quick check, but (at least in Delphi 7) an exception in one destructor will stop the other destructors, sadly enough. One way to stop this is write try/except's in each destructor, but this is again more code somewhere else just to save on code in the first place...

type
  IMyIntf=interface(IInterface)
    function GetName:string;
    procedure SetName(const Name:string);
    property Name:string read GetName write SetName;
  end;

  TMyObj=class(TInterfacedObject, IMyIntf)
  private
    FName:string;
    function GetName:string;
    procedure SetName(const Name:string);
  public
    constructor Create(const Name:string);
    destructor Destroy; override;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  x,y:IMyIntf;
begin
  x:=TMyObj.Create('a');
  y:=TMyObj.Create('b');

  x.Name:='x';
  y.Name:='y';
end;

{ TMyObj }

constructor TMyObj.Create(const Name: string);
begin
  inherited Create;
  FName:=Name;
end;

destructor TMyObj.Destroy;
begin
  MessageBox(Application.Handle,PChar(FName),'test',MB_OK);
  //test: raise Exception.Create('Destructor '+FName);
  inherited;
end;

function TMyObj.GetName: string;
begin
  Result:=FName;
end;

procedure TMyObj.SetName(const Name: string);
begin
  FName:=Name;
end;