(转)Delphi2009初体验 - 语言篇 - 智能指针(Smart Pointer)的实现

 转载：http://www.cnblogs.com/felixYeou/archive/2008/08/27/1277250.html

快速导航

一、 回顾历史
二、 智能指针简介
三、 Delphi中的interface
四、 Delphi中智能指针的实现
五、 interface + 泛型 = 强类型的智能指针！
六、 智能指针与集合
七、 注意事项
八、 总结

本随笔所有源代码打包下载

一、回顾历史

在c++中，对象可以创建在栈里，也可以创建在堆里。如：

class CTestClass
{
public:
    CTestClass()
    {
        printf(“Create”);
    }

    void DoPrint() {}

    ~CTestClass()
    {
        printf(“destroy”);
    }
}

// 以下代码创建栈对象

CTestClass test;
test.DoPrint();

栈对象生命周期由后台管理。当方法结束时，栈对象会从栈中弹出，编译器会自动销毁栈所弹出的对象。

// 以下代码创建堆对象

CTestClass* test = new CTestClass();
test->DoPrint();

堆对象保存在堆中，堆对象生命周期不受后台管理，程序员必须自己手动的释放堆对象，否则会造成内存泄露：

delete test;
test = NULL;

Pascal语言从OOP Pascal开始支持面向对象，也就是说，OOP Pascal支持创建对象了。OOP Pascal和c++一样，也可以分别创建栈对象和堆对象：

我们最常见的OOP Pascal堆对象的定义和创建：

Code
type
    THeapObject = class  // 注意此处的声明，class表名为堆对象
    public
        constructor Create; virtual;
        destructor Destroy; override;
        procedure DoPrint;
    end;

var
    heapObj: THeapObject;

{ TStackObject }

constructor THeapObject.Create;
begin
    Writeln('Create');
end;

destructor THeapObject.Destroy;
begin
    Writeln('Destroy');
end;

procedure THeapObject.DoPrint;
begin
    Writeln('DoPrint');
end;

begin
    heapObj := THeapObject.Create;
    heapObj.DoPrint;
    FreeAndNil(heapObj);

    Readln;
end.

运行结果：

OOP Pascal也有栈对象，栈对象的定义和创建：

type
    TStackObject = object  // 注意此处的声明，object为保留字表明为栈对象
    public
        constructor Create;
        destructor Destroy;
        procedure DoPrint;
    end;

var
    stackObj: TStackObject;

{ TStackObject }

constructor TStackObject.Create;
begin
    Writeln('Create');
end;

destructor TStackObject.Destroy;
begin
    Writeln('Destroy');
end;

procedure TStackObject.DoPrint;
begin
    Writeln('DoPrint');
end;

begin
    // 注意此处的代码，不需要使用TStackObject.Create
    stackObj.DoPrint;

    Readln;
end.

运行结果：

从结果我们可以看到，与c++不同的是，OOP Pascal所谓的栈对象的构造和析构，不受constructor方法和destructor方法控制，我们不能捕获到OOP Pascal栈对象的构造和析构。

二、智能指针简介

经过前面分析，我们知道，栈对象的声明周期由后台管理，栈对象在声明时进行构造，当方法退出或者类被销毁时（此时栈对象为类的成员变量），栈对象的生命周期也会随着结束，后台自动会调用它们的析构函数并释放栈空间。
而堆对象必须由程序员手动的释放，如果一个方法只有一两个堆对象我们还能应付的过来，但是当堆对象非常多，而且堆对象一般都要经过多个方法的传递、赋值，传递到最后，非常容易忘了delete，造成内存泄露。

能不能让后台也去自动管理堆对象的释放呢？前辈们想到一个办法，就是让一个栈对象包含一个堆对象的引用，当栈对象被后台自动释放时，会调用栈对象的析构函数，于是，在栈对象的析构函数里写下delete堆对象指针的语句。这样，就完成了后台间接管理堆对象，以上就是stl中的智能指针auto_ptr的处理方法。

三、Delphi中的interface

从智能指针的简介中我们可以了解到，要使用智能指针，我们必须得捕获到栈对象的构造函数，将堆对象的指针传入栈对象，由栈对象保存堆对象的指针；还必须捕获到栈对象的析构函数，在栈对象的析构函数里进行对构造函数所传入堆对象指针delete。在c++很容易做到这一点，但是经上面分析，我们无法对Delphi的栈对象进行构造和析构的捕获。
我们可以换一种角度思考，不一定非要是栈对象，只要在Delphi中能有一种东西，只要出了它的作用域，它就能自动析构！

Delphi中的interface能间接满足我们这个需要，请看以下例子：

Code
program TestInterface;

{$APPTYPE CONSOLE}

uses
    SysUtils;

type
    ITestInterface = interface
    ['{ED2517D5-FB77-4DD6-BC89-DF9182B335AE}']
        procedure DoPrint;
    end;

    TTestInterface = class(TInterfacedObject, ITestInterface)
    public
        constructor Create; virtual;
        destructor Destroy; override;
        procedure DoPrint;
    end;

{ TTestInterface }

constructor TTestInterface.Create;
begin
    Writeln('Create');
end;

destructor TTestInterface.Destroy;
begin
    Writeln('Destroy');

    inherited;
end;

procedure TTestInterface.DoPrint;
begin
    Writeln('DoPrint');
end;

procedure DoTest;
var
    testInter: ITestInterface;      // 1*
begin
    testInter := TTestInterface.Create;
    testInter.DoPrint;
end;

begin
    DoTest;
    Readln;
end.

有结果可以看到，代码中没有释放testInter指向的对象，对象由后台释放了。如果将1*处改为testInter: TTestInterface；则结果如下，我们将看到如果不声明为接口，即使创建同一个对象，Delphi是不会自动释放对象的。

在此，我们利用了接口的自动管理功能，它自己维护着一个引用计数，当引用计数为0时接口自己会调用析构函数。关于Delphi接口的一些概念以及为什么后台会自动释放接口，可以参考以下两篇文章，在此不做多余叙述。

1、 Delphi 的接口机制浅探http://www.d99net.net/article.asp?id=206
2、 浅谈引用计数http://www.moon-soft.com/doc/13056.htm

四、Delphi中智能指针的实现

有了以上经验，我们就可以实现我们的智能指针了！

首先，我们要创建一个继承于TInterfacedObject的对象，在构造函数中传入要管理的堆对象的引用，在析构函数里FreeAndNil这个堆对象的引用。代码如下：

unit ClassicalAutoPtr;

interface

uses
    SysUtils;

type
    TClassicalAutoPtr = class(TInterfacedObject)
    private
        fObj: TObject;
    public
        constructor Create(aObj: TObject); virtual;
        destructor Destroy; override;
        class function New(aObj: TObject): IInterface;
    end;

implementation

{ TClassicalAutoPtr }

constructor TClassicalAutoPtr.Create(aObj: TObject);
begin
    fObj := aObj;
end;

destructor TClassicalAutoPtr.Destroy;
begin
    // 智能指针在方法退出时销毁，同时销毁所管理的堆对象
    FreeAndNil(fObj);
    inherited;
end;

class function TClassicalAutoPtr.New(aObj: TObject): IInterface;
begin
    // 外部必须使用此方法创建智能指针
    // 因为此方法会暴露给外部一个接口
    // 后台碰到接口后会自动调用接口的析构函数
    Result := TClassicalAutoPtr.Create(aObj);
end;

end.

然后我们写一个控制台程序做试验：

program TestClassicalAutoPtr;

{$APPTYPE CONSOLE}

uses
    SysUtils,
    ClassicalAutoPtr in 'ClassicalAutoPtr.pas';

type
    TTestClass = class
    public
        constructor Create; virtual;
        destructor Destroy; override;
        procedure DoPrint;
    end;

{ TTestClass }

constructor TTestClass.Create;
begin
    Writeln('Create');
end;

destructor TTestClass.Destroy;
begin
    Writeln('Destroy');
    inherited;
end;

procedure TTestClass.DoPrint;
begin
    Writeln('DoPrint');
end;

procedure DoTest;
var
    tt: TTestClass;
begin
    // 首先创建一个堆对象
    tt := TTestClass.Create;

    // 创建一个智能指针，并把堆对象的引用传入智能指针，由智能指针管理堆对象
    TClassicalAutoPtr.New(tt);    // 2*
    tt.DoPrint;
end;

begin
    DoTest;
    Readln;
end.

代码执行结果如下图所示：

如果我们将代码2*处替换成
TClassicalAutoPtr.Create (tt);

执行结果将看不到Destroy，析构函数没有被调用。因为由TClassicalAutoPtr.New返回的是一个interface，而TClassicalAutoPtr.Create返回的是一个Object。

这样，我们一个简单的智能指针就完成了。

五、interface + 泛型 = 强类型的智能指针

D2009引入了泛型，我们把程序稍微改动一下，就可以支持强类型的智能指针了！

关于D2009对泛型的支持的分析，请参看我另外两篇随笔：
http://www.cnblogs.com/felixYeou/archive/2008/08/22/1273989.html
http://www.cnblogs.com/felixYeou/archive/2008/08/22/1274202.html

我们以stl的auto_ptr作为参照物，要是咱们的智能指针看起来“优雅”，必须还要实现以下几个方法：
1、 Get：返回智能指针所指向的对象
2、 Release：释放智能指对堆对象的管理，智能指针被自动释放后，不对堆对象进行释放
3、 Reset：为智能指针指向其它堆对象，同时释放原来指向的堆对象

对于auto_ptr一些运算符重载，这里不考虑在内，因为Delphi2009还没有支持类的运算符重载。
话不多说了，直接上代码：

智能指针类代码：

unit AutoPtr;

interface

uses
    SysUtils;

type
    IAutoPtr<T: class> = interface(IInterface)
        ['{BD098FDB-728D-4CAC-AE40-B12B8B556AD3}']
        function Get: T;
        function Release: T;
        procedure Reset(aObj: T);
    end;

    TAutoPtr<T: class> = class(TInterfacedObject, IAutoPtr<T>)
    private
           fObj: T;
    public
           class function New(aObj: T): IAutoPtr<T>;
           constructor Create(aObj: T); virtual;
           destructor Destroy; override;
        function Get: T;
        function Release: T;
        procedure Reset(aObj: T);
    end;

implementation

{ TAutoPtr<T> }

constructor TAutoPtr<T>.Create(aObj: T);
begin
    fObj := aObj;
end;

class function TAutoPtr<T>.New(aObj: T): IAutoPtr<T>;
begin
    Result := TAutoPtr<T>.Create(aObj) as IAutoPtr<T>; // 注意：此处如果不加as IAutoPtr<T>，程序运行时会报错，第一次我没有加as IAutoPtr<T>程序运行一切正常，到后面就不行了，不知道是为什么
end;

function TAutoPtr<T>.Release: T;
begin
    Result := fObj;
    fObj := nil;
end;

procedure TAutoPtr<T>.Reset(aObj: T);
begin
    if aObj <> fObj then
    begin
        FreeAndNil(fObj);
        fObj := aObj;
    end;
end;

destructor TAutoPtr<T>.Destroy;
begin
    if fObj <> nil then
    begin
        FreeAndNil(fObj);
    end;

    inherited;
end;

function TAutoPtr<T>.Get: T;
begin
    Result := fObj;
end;

end.

测试代码：

program TestAutoPtr;

{$APPTYPE CONSOLE}

uses
    SysUtils,
    AutoPtr in 'AutoPtr.pas';

type
    TTestClass = class
    private
        fInt: Integer;
    public
        constructor Create(aInt: Integer); virtual;
        destructor Destroy; override;
        procedure DoPrintInt;
    end;

{ TTestClass }

constructor TTestClass.Create(aInt: Integer);
begin
    fInt := aInt;
    Writeln('Create');
end;

destructor TTestClass.Destroy;
begin
    Writeln('Destroy');

    inherited;
end;

procedure TTestClass.DoPrintInt;
begin
    Writeln(fInt);
end;

procedure DoTestAutoPtr;
var
    ap: IAutoPtr<TTestClass>;
begin
    // 此处用Create和New都可以，因为ap对象是接口
    ap := TAutoPtr<TTestClass>.Create(TTestClass.Create(10));
    ap.Get.DoPrintInt;  // 3*
end;

begin
    DoTestAutoPtr;
    Readln;
end.

测试结果为：

然而我们将3*处代码改成
ap.Release.DoPrintInt，则输出结果为

因为Release方法已经通知智能指针不管理堆对象了。

同时，我们还可以把DoTestAutoPtr方法写成这样，或许这样创建TTestClass对象更优美一些：

procedure DoTestAutoPtr;
var
    tt: TTestClass;
begin
    // 注意，此处要用New
    tt := TAutoPtr<TTestClass>.New(TTestClass.Create(10)).Get;

    tt.DoPrintInt;
 
      // 不需要使用tt.Free;

end;

六、智能指针与集合

如果我们声明一个全局变量：

var
    gAp: IAutoPtr<TTestClass>;

并从DoTestAutoPtr方法开始改变其下代码：

procedure DoTestAutoPtr;
var
    tt: TTestClass;
    ap: IAutoPtr<TTestClass>;
begin
    ap := TAutoPtr<TTestClass>.New(TTestClass.Create(10));
    tt := ap.Get;
    tt.DoPrintInt;
    gAp := ap;
end;

begin
    DoTestAutoPtr;
    Writeln('Exit DoTestAutoPtr');

    Writeln('gAp nil');
    gAp := nil;   // 4*

    Readln;
end.

结果如下：

我们可以看到，当调用完毕DoTestAutoPtr方法后，方法内的堆对象tt并没有销毁，这说明智能指针ap并没有销毁。
因为在DoTestAutoPtr方法最后一行，将ap接口变量赋值给了全局变量gAp，此时接口的引用计数+1，方法退出后，ap变量被销毁，接口的引用计数-1，但是gAp仍然引用着对象，所以引用计数不为0。当运行到第4*步时，强制把gAp指向空地址，对象的引用计数-1，为0，这个时候后台自动调用对象的析构函数Destroy（这有点像Java或.net的垃圾回收机制）。所以，我们使用智能指针，可以放心的创建，放心的引用，而不用去管什么时候该销毁，完全由后台帮我们实现。

下面把测试程序改一下，让智能指针与集合结合测试：

Code
program TestAutoPtrList;

{$APPTYPE CONSOLE}

uses
    SysUtils,
    Generics.Collections,
    AutoPtr in 'AutoPtr.pas';

type
    TTestClass = class
    private
        fInt: Integer;
    public
        constructor Create(aInt: Integer); virtual;
        destructor Destroy; override;
        procedure DoPrintInt;
    end;

var
    gList: TList<IAutoPtr<TTestClass>>;
    gAp: IAutoPtr<TTestClass>;

{ TTestClass }

constructor TTestClass.Create(aInt: Integer);
begin
    fInt := aInt;
    Writeln('Create');
end;

destructor TTestClass.Destroy;
begin
    Writeln('Destroy');

    inherited;
end;

procedure TTestClass.DoPrintInt;
begin
    Writeln(fInt);
end;

procedure DoTestAutoPtr;
var
    ap: IAutoPtr<TTestClass>;
    n: Integer;
begin
    gList := TList<IAutoPtr<TTestClass>>.Create;
    for n := 0 to 2 do
    begin
        ap := TAutoPtr<TTestClass>.New(TTestClass.Create(10));
        ap.Get.DoPrintInt;

        gList.Add(ap);
        ap := nil;
    end;

    Writeln('Save an AutoPtr');
    gAp := gList[1];

    Writeln('gList Destroy');
    gList.Free;

    Writeln('Set saved AutoPtr = nil');
    gAp := nil;
end;

begin
    DoTestAutoPtr;

    Readln;
end.

测试结果：

七、注意事项

1、智能指针与堆对象之间的循环引用

假如我们把TTestClass类进行如下修改，让堆对象拥有指向它智能指针的引用：

    TTestClass = class
    private
        fInt: Integer;
        fAp: IAutoPtr<TTestClass>;
    public
        constructor Create(aInt: Integer); overload; virtual;
        destructor Destroy; override;
        procedure DoPrintInt;
        property Ap: IAutoPtr<TTestClass> read fAp write fAp;
    end;

同时，把测试方法进行如下修改：

procedure DoTestAutoPtr;
var
    tt: TTestClass;
    ap: IAutoPtr<TTestClass>;
begin
    ap := TAutoPtr<TTestClass>.New(TTestClass.Create(10));
    tt := ap.Get;
    tt.Ap := ap;    // 5*
    tt.DoPrintInt;
end;

此时，我们得到了非常不靠谱的结果：

智能指针竟然没有自动释放！

从上面的分析和前面的代码我们可以看到，接口的引用计数为0的时候，接口会自动释放，我们要保证接口能够被顺利的释放，必须保证接口的引用计数为0。

从第 5* 点代码我们可以看到，tt.Ap := ap，使得智能指针与堆对象之间进行了循环引用，导致接口ap的引用计数+1为2。最后在方法退出的时候，虽然ap占用的引用已经被释放了，引用-1，但是由于堆对象tt不会自己释放，所以堆对象tt.Ap所占用的引用没有释放，方法在退出时，接口的引用数为1，接口没有自动释放。

2、什么使用时候使用Release方法

首先我们为测试单元加入use：Generics.Collections，再将TTestClass类修改如下：

type
    TTestClass = class
    private
        fList: TList<Integer>;
    public
        constructor Create(aInt: Integer); overload; virtual;
        destructor Destroy; override;
        procedure DoPrintInt;
    end;

{ TTestClass }

constructor TTestClass.Create(aInt: Integer);
begin
      inherited Create;

    fList := TList<Integer>.Create;
    fList.Add(aInt);
    Writeln('Create');
end;

destructor TTestClass.Destroy;
begin
    Writeln('Destroy');
    FreeAndNil(fList);

    inherited;
end;

procedure TTestClass.DoPrintInt;
begin
    Writeln(fList[0]);
end;

此时，成员变量不再是一个值类型，而是一个引用类型。

将从DoTestAutoPtr方法开始代码修改如下：

procedure DoTestAutoPtr;
begin
    gTt := TAutoPtr<TTestClass>.New(TTestClass.Create(10)).Get;  // 6*
end;

begin
    DoTestAutoPtr;
    gTt.DoPrintInt;

    Readln;
end.

此时，我们在DoTestAutoPtr方法内部创建了智能指针，并将智能指针所指向的堆对象传给全局变量，然后在DoTestAutoPtr方法执行结束后调用全局变量的DoPrintInt方法。运行结果：

运行失败了，原因是在DoTestAutoPtr方法退出了以后，TAutoPtr<TTestClass>.New(TTestClass.Create(10))语句所创建的接口引用计数为0，此时它会调用TTestClass的Destroy方法将fList销毁。此时，我们调用DoPrintInt方法，想得到fList第一个元素，但是fList本身已经被销毁了，所以导致错误的发生。

我们将第6*行改为：

gTt := TAutoPtr<TTestClass>.New(TTestClass.Create(10)).Release;

运行结果：

此时不会出现错误，因为Release方法已经通知智能指针堆对象已经不受智能指针管理，所以在TAutoPtr<TTestClass>销毁的时候不会调用 TTestClass的析构函数，fList得以保留下来。

在此处我们可以看到，由于堆对象不再受到智能指针的管理，所以我们必须手动的将其释放FreeAndNil(gTt)，否则就会产生上图所发生的结果：内存泄露。

八、总结

刚开始实现栈对象我考虑过使用record，Delphi的record非常类似于类，保存在栈中，支持方法、属性和带参数的构造函数，但是不支持析构函数，所以没有办法实现我们的智能指针。Delphi版的智能指针很早就在cnPack讨论区中有前辈提出来过了（http://bbs.cnpack.org/viewthread.php?tid=1399），但是使用起来不方便导致这种写法不怎么流行。自从D2009支持泛型以后，以前很多实现起来很麻烦的功能现在都能很简单的实现，如智能指针与泛型集合的结合。但是，在Delphi中使用智能指针是稍微有一些性能损失的，在目前电脑速度越来越快的今天，这点损失已经显得微不足道了。

本随笔所有源代码打包下载:http://files.cnblogs.com/felixYeou/auto_ptr_code.rar