避免嵌套的 try...finally 块在 Delphi

Question

今天早上我有这样一个想法，即避免嵌套 try finally 块，如下所示

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;

利用接口的自动引用计数，我想出了

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;

这样前面的代码块就变成了

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;

我的问题是：这行得通还是我忽略了什么？

在我看来，这看起来很酷，并且通过减少嵌套量使代码更易于阅读。它还可以扩展为存储匿名方法列表以运行以执行诸如关闭文件、查询等操作...

Answer 1

是的，它有效。

也许原始代码的嵌套 try-finally 块与使用引用计数对象来管理其他对象的生命周期的技术之间的唯一不同之处在于，如果在销毁任何对象时出现问题会发生什么。如果在销毁任何对象时出现异常，嵌套的 try-finally 块将确保任何剩余的对象仍将被释放。 TObjectList 中的 TDoFinally 不会这样做；如果列表中的任何项目无法销毁，则列表中的任何后续项目都将被泄露。

不过，实际上，这并不是一个真正的问题。任何析构函数都不应该抛出异常。如果确实如此，那么无论如何也没有任何方法可以从中恢复，因此是否有任何泄漏无关紧要。无论如何，您的程序应该会立即终止，因此有一个整洁的清理例程并不重要。

顺便说一句，JCL 已经提供了ISafeGuard 和IMultiSafeGuard 接口来管理本地对象的生命周期。例如，您可以像这样重写您的代码：

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;

该库也不处理析构函数中的异常。

Answer 2

我通常会这样做，以在代码可读性和复杂性之间取得平衡：

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;

警告：

• 这并不完全等同于你的原始代码，因为如果T3.Free 抛出异常，T2 和T1 将不会被释放并导致内存泄漏，对于T2.Free 中的相同尊重T1。

• 但是，正如 Rob Kennedy 在他的评论中指出的那样，并在 his answer 中进行了更详细的解释，它等同于您使用 IDoFinally 的替代代码。

• 所以你的两种方法并不完全等价。

Answer 3

Smart pointers是实现自动内存管理的另一种方式。

ADUG 网站上有一篇 Delphi implementation 源自 Barry Kelly's 文章，介绍如何在 Delphi 中使用泛型、匿名方法实现强类型智能指针和接口：

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

您的代码将被重写为：

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

我有一组辅助函数可以让@JRL 的方法更易于理解。

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;

事实上，我的代码有更多参数的版本。为便于维护，此代码全部由简短的 Python 脚本自动生成。

这些方法以显而易见的方式实现，例如

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;

这使我们可以像这样重写问题中的代码：

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

还有 Python 脚本：

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

我有时使用的替代方法：

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

是的，此代码有效，尽管我个人倾向于将inherited 添加到您的构造函数和析构函数中。

有很多库都有使用这种机制的实现。用于移动平台的最新 Delphi 编译器使用 ARC（自动引用计数）管理对象生命周期，这是相同的技术，但融入了编译器对对象引用的处理。

Answer 7

这是相同想法的稍微不同的实现：

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.

优点是使用简单，如：

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;

您可以在方法的开头创建 Guard 并在一次调用中传递任意数量的变量，这很方便。所以你不必先创建对象实例。

还要注意变量将在构造函数中自动初始化为 nil。

编辑： 此外，由于接口生命周期等于方法的执行时间，我们可以将其用于分析，也许 IFDEF ed 更容易控制。

Answer 8

根据最终目的来理解使用哪种方法很棘手，但在某些情况下，我倾向于实现子例程，或者通常将我的代码分成不同的函数。比如……

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;

同样，如果没有更真实的场景，您将很难理解这将如何工作。我仍在考虑一个很好的例子，当我想到一个时会很乐意编辑。不过总体思路是将业务规则的不同部分分成不同的可重用代码块。

或者，您也可以将参数从一个过程传递到下一个过程，而不是声明全局变量。

Answer 9

我认为没有必要将析构函数包装在接口中。默认情况下，Delphi 会在每个使用接口的过程/函数中构建一个幕后 try/finally，其中接口的引用计数会减少，从而在达到零时调用析构函数。

我进行了快速检查，但（至少在 Delphi 7 中）一个析构函数中的异常将停止其他析构函数，这很可悲。阻止这种情况的一种方法是在每个析构函数中编写 try/except，但这又是其他地方的更多代码，只是为了首先节省代码......

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;