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

来源:互联网 发布:3b编程简单图形实例 编辑:程序博客网 时间:2024/06/07 23:18

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

                                                                                                                                                                                                 作者:   杨芹勍

(一)

一、回顾历史

 在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堆对象的定义和创建:

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.

运行结果:
----------------X
create...           |
doprint...          |
Destroy...        |
----------------
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.

运行结果:
----------------X
doprint...          |
                       |
                       |
----------------

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

 二、智能指针简介

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

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

 三、Delphi中的interface

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

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

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.

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

----------------X
create.....         |
doprint...         |
                      |
----------------

在此,我们利用了接口的自动管理功能,它自己维护着一个引用计数,当引用计数为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;interfaceuses    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.

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

----------------X
create.....         |
doprint...         |
destroy...        |
----------------

如果我们将代码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;interfaceuses    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.

 测试结果为:

----------------X
create.....         |
doprint...         |
destroy...        |
----------------
然而我们将3*处代码改成
ap.Release.DoPrintInt,则输出结果为

----------------X
create.....         |
doprint...         |
                      |
----------------

因为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.

结果如下:

-------------------------X
create.....                     |
10                               |
Exit DoTestAutoPtr       |
gAp nil                         |
Destroy                       |
-------------------------

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

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

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.

测试结果:

-------------------------X
create.....                     |
10                               |
create.....                     |
10                               |
create.....                     |
10                               |
Save an AutoPtr            |
gList Destroy                |
Destroy                        |
Destroy                        |
Set saved AutoPer = nil  |
Destroy                        |
-------------------------

七、注意事项

 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;

此时,我们得到了非常不靠谱的结果:

-------------------------X
create.....                     |
10                               |
                                   |
                                   |
--------------------------

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

  从上面的分析和前面的代码我们可以看到,接口的引用计数为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方法。运行结果:

--------------------------------------------------------------------------X
create.....                                                                                         |
Destroy                                                                                           |
Access violation at address 00414B38 in module 'TestAutoPtr.exe'.       |
s 00000008                                                                                      |
                                                                                                       |
--------------------------------------------------------------------------

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

 

我们将第6*行改为:

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

运行结果:

-------------------X
create.....             |
10                       |
                           |
--------------------

此时不会出现错误,因为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


(二)

一、弊端 

在此先要感谢网友装配脑袋的提醒,在我关于Delphi中实现智能指针的第一篇文章“Delphi2009初体验 - 语言篇 - 智能指针的实现”里,装配脑袋给我提出了这么个问题:

 

管这个叫智能指针未免名不副实了一点,实际上class型的对象引用与指针的语义有跟大的不同。而C++的智能指针就是为了在语义上获得方便性的一种机制。 

 

后来我想了想,确实存在装配脑袋所表述的问题。在原来的代码中,我进行了如下约束:

IAutoPtr<T: class> = interface(IInterface)

我将T类型规定为必须为一个类类型(class型),如果使用TAutoPtr包囊class型的TObject,那么TAutoPtr只能算是一个“智能对象”,而不是“智能指针”。在此,我们把T: class的约束class去掉,此处就能传入非class型的类型了,当然也包括指针类型。

二、提出问题 

然而,把约束: class去掉,会带来一些问题:

首先贴出原来的代码:

 1 type 2     IAutoPtr<T: class> = interface(IInterface) 3         ['{BD098FDB-728D-4CAC-AE40-B12B8B556AD3}'] 4         function Get: T; 5         function Release: T; 6         procedure Reset(aObj: T); 7     end; 8  9     TAutoPtr<T: class> = class(TInterfacedObject, IAutoPtr<T>)10     private11            fObj: T;12     public13            class function New(aObj: T): IAutoPtr<T>;14            constructor Create(aObj: T); virtual;15            destructor Destroy; override;16         function Get: T;17         function Release: T;18         procedure Reset(aObj: T);19     end;20 21 implementation22 23 { TAutoPtr<T> }24 25 constructor TAutoPtr<T>.Create(aObj: T);26 begin27     fObj := aObj;28 end;29 30 class function TAutoPtr<T>.New(aObj: T): IAutoPtr<T>;31 begin32     Result := TAutoPtr<T>.Create(aObj) as IAutoPtr<T>; // 注意:此处如果不加as IAutoPtr<T>,程序运行时会报错,第一次我没有加as IAutoPtr<T>程序运行一切正常,到后面就不行了,不知道是为什么33 end;34 35 function TAutoPtr<T>.Release: T;36 begin37     Result := fObj;38     fObj := nil;39 end;40 41 procedure TAutoPtr<T>.Reset(aObj: T);42 begin43     if aObj <> fObj then44     begin45         FreeAndNil(fObj);46         fObj := aObj;47     end;48 end;49 50 destructor TAutoPtr<T>.Destroy;51 begin52     if fObj <> nil then53     begin54         FreeAndNil(fObj);55     end;56     57     inherited;58 end;59 60 function TAutoPtr<T>.Get: T;61 begin62     Result := fObj;63 end;

1、在Release方法内的“fObj := nil”,编译器将不支持,因为fObj为T类型,T可以为值类型,值类型赋值为nil是不允许的。

2、在Reset(aObj: T)方法内的“aObj <> fObj”,编译器将不支持,虽然aObj和fObj都为T类型,但是泛型T为任意类型,并不是任何类型都支持“<>”比较运算符的。

 

3、Destroy方法内的“if fObj = nil then”不被支持,原因和第一点一样。

4、Destroy方法内的“FreeAndNil(fObj)”不被支持,因为T可能是值类型,原因和第一点一样。

三、解决问题

在解决问题之前,我们先进行如下的规定:

TAutoPtr<T>中的T智能传入Class类型或指针类型,不能传入如Integer、record这样的保存在栈上的类型,因为这样是没有意义的。如果能有这样的约束:“TAutoPtr<T: class or Pointer>”就好了

 

解决问题:

1、“fObj := nil”,fObj为指针,我们可以改成“Integer((@fObj)^) := 0;

2、“aObj <> fObj”,有了第一点,第二点也好改了:“Integer((@aObj)^) <> Integer((@fObj)^)

3、“if fObj = nil then” ,改为:“if Integer((@fObj)^) <> 0 then

 

4、这一点比较麻烦,因为我们即使按照约定T必须为class或Pointer,fObj必须为一个指针,也不能拥有像c++一样的delete函数。 虽然Delphi拥有Dispose函数,但是Dispose函数不能够实现Free方法。

所以,我们必须根据T的类型分别处理,如果是class型则Free,如果是指针类型则用另外一种方法处理。

 

首先,我们通过如下方法获取T的类型信息:

uses    TypInfo;var    fTypeInfo: PTypeInfo;begin    // 获取泛型的类型    fTypeInfo := TypeInfo(T);end;

1)针对于class类型,我们可以这样处理:
if fTypeInfo.Kind = tkClass then    TObject((@fObj)^).Free;

2)由于Pointer不包含类型信息,如果T为Pointer,则fTypeInfo为nil。然而,释放指针有两种方法,Dispose和FreeMem。关于Dispose和Freemem的区别,请阅读以下文章《Delphi的指针》。

通过查看System.pas中的代码我发现,Delphi在Dispose的时候已经调用了FreeMem方法:

 PUSH    EAX CALL    _Finalize POP     EAX CALL    _FreeMem

_Finalize方法是做对有类型的指针(如:PGUID)所指向的结构体变量的一些“善后工作”,如果为纯Pointer,_Finalize方法内将不执行:
asm{       ECX number of elements of that type             }        CMP     ECX, 0                        { no array -> nop }        JE      @@zerolength@@zerolength:end;
所以,我们就可以放心的使用Dispose方法了:
if fTypeInfo = nil then        //FreeMem(Pointer((@fObj)^))        // 此处应该调用Dispose,因为Dispose内部已经实现FreeMem:        // PUSH    EAX        // CALL    _Finalize        // POP     EAX        // CALL    _FreeMem        Dispose(Pointer((@fObj)^));

四、改进New方法

在方法New中,我们将指针传入智能指针内部,由智能指针来管理指针的自动释放。在翻译Java的Json-RPC的时候,为了实现类似于Java的垃圾回收功能,我使用到了智能指针。当翻译到JSONObject的时候,我发现New方法非常的麻烦:

fMyHashMap := TAutoPtr<TDictionary<string, IAutoPtr<TObject>>>.New(TDictionary<string, IAutoPtr<TObject>>.Create);

我已经告诉TAutoPtr<T>,T的类型为TDictionary<string, IAutoPtr<TObject>>,我能不能写一个New的重载方法,让它自动实现对T的创建呢?如果T的约束为T: class或T: constructor,则很好实现:T.Create即可。现在,T没有任何约束,如果加了T.Create编译器是不支持的。我研究出了一种可行的方法,代码如下:
class function TAutoPtr<T>.New: IAutoPtr<T>;var    typInfo: PTypeInfo;    obj: TObject;    objNew: T;begin    typInfo := TypeInfo(T);    // 在此处只能创建class型的指针,不能创建无类型指针    // 因为指针在Delphi中有两种初始化方式    // 1、GetMem(p, 100);    // 2、New(p);    if (typInfo <> nil) and (typInfo.Kind = tkClass) then    begin        // 获取T的类型并调用默认构造函数创建对象        obj := GetTypeData(typInfo).ClassType.Create;        // 使用以下方法强制转换        objNew := T((@obj)^);        Exit(New(objNew));    end;    raise Exception.Create('只能构造class型的对象。');end;

原理在代码的注释中写得很清楚了,这里只能针对class型的类型做构造,Pointer型的类型会抛出异常。

五、完整代码 

{******************************************************** Delphi Smart Pointer class* AutoPtr* Version 0.2 beta* Yang Qinqing @ http://www.cnblogs.com/felixyeou********************************************************}unit AutoPtr;interfaceuses    SysUtils,    TypInfo;type    IAutoPtr<T> = interface        ['{86DB82D6-9A32-4A6A-9191-2E0DFE083C38}']        function Get: T;        function Release: T;        procedure Reset(aObj: T);    end;    TAutoPtr<T> = class(TInterfacedObject, IAutoPtr<T>)    private           fObj: T;        fTypeInfo: PTypeInfo;        procedure FreeObj;    public           class function New(aObj: T): IAutoPtr<T>; overload;        class function New: IAutoPtr<T>; overload;           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;    // 获取泛型的类型    fTypeInfo := TypeInfo(T);end;class function TAutoPtr<T>.New(aObj: T): IAutoPtr<T>;begin    Result := TAutoPtr<T>.Create(aObj) as IAutoPtr<T>;end;function TAutoPtr<T>.Release: T;begin    Result := fObj;    // fObj := nil    Integer((@fObj)^) := 0;end;procedure TAutoPtr<T>.Reset(aObj: T);begin    // aObj <> fObj then    if Integer((@aObj)^) <> Integer((@fObj)^) then    begin        FreeObj;        fObj := aObj;    end;end;destructor TAutoPtr<T>.Destroy;begin    // if fObj = nil then..    if Integer((@fObj)^) <> 0 then        FreeObj;    fTypeInfo := nil;    inherited;end;procedure TAutoPtr<T>.FreeObj;begin    // 此处如果TypeInfo为空,则说明T为Pointer    // 此处只要简单的释放内存即可    if fTypeInfo = nil then        //FreeMem(Pointer((@fObj)^))        // 此处应该调用Dispose,因为Dispose内部已经实现FreeMem:        // PUSH    EAX        // CALL    _Finalize        // POP     EAX        // CALL    _FreeMem        Dispose(Pointer((@fObj)^))    else    begin        case fTypeInfo.Kind of            tkClass:                // 调用Object.Free,进而调用Destructor Dispose(virtual)方法                // 实现在对象树上的遍历释放                TObject((@fObj)^).Free;            tkArray, tkDynArray:                // 数组和动态数组无需释放        end;    end;    // fobj := nil;    Integer((@fObj)^) := 0;end;function TAutoPtr<T>.Get: T;begin    Result := fObj;end;class function TAutoPtr<T>.New: IAutoPtr<T>;var    typInfo: PTypeInfo;    obj: TObject;    objNew: T;begin    typInfo := TypeInfo(T);    // 在此处只能创建class型的指针,不能创建无类型指针    // 因为指针在Delphi中有两种初始化方式    // 1、GetMem(p, 100);    // 2、New(p);    if (typInfo <> nil) and (typInfo.Kind = tkClass) then    begin        // 获取T的类型并调用默认构造函数创建对象        obj := GetTypeData(typInfo).ClassType.Create;        // 使用以下方法强制转换        objNew := T((@obj)^);        Exit(New(objNew));    end;    raise Exception.Create('只能构造class型的对象。');end;end.
..

修改部分用粗体表示,增加了对对象重复加载智能指针的检测
{******************************************************** Delphi Smart Pointer class* AutoPtr* Version 0.21 beta* Yang Qinqing @ http://www.cnblogs.com/felixyeou********************************************************}unit AutoPtr;interfaceuses    SysUtils,    TypInfo,    Generics.Collections;type    IAutoPtr<T> = interface        ['{86DB82D6-9A32-4A6A-9191-2E0DFE083C38}']        function Get: T;        function Release: T;        procedure Reset(aObj: T);    end;    TAutoPtr<T> = class(TInterfacedObject, IAutoPtr<T>)    private           fObj: T;        fTypeInfo: PTypeInfo;        procedure FreeObj;    protected           constructor Create(aObj: T); virtual;    public           class function New(aObj: T): IAutoPtr<T>; overload;        class function New: IAutoPtr<T>; overload;           destructor Destroy; override;        function Get: T;        function Release: T;        procedure Reset(aObj: T);    end;var    // 对象图,用来存放对象实体与智能对象的指针的对应关系    // Key存放对象,Value存放智能指针    fObjMap: TDictionary<Pointer, Pointer> = nil;    pair: TPair<Pointer, Pointer>;implementation{ TAutoPtr<T> }constructor TAutoPtr<T>.Create(aObj: T);begin    fObj := aObj;    // 获取泛型的类型    fTypeInfo := TypeInfo(T);end;class function TAutoPtr<T>.New(aObj: T): IAutoPtr<T>;var    p: Pointer;begin    // 此处不能简单的使用.Create创建智能指针    // 因为aObj的智能指针可能已经创建    // 直接在创建aObj的智能指针,释放时可能会导致两次释放    // 从而出错,所以此处要判断aObj是否被创建过智能指针    // 获取aObj指针    p := Pointer((@aObj)^);    // 判断图中是否有对象存在    if fObjMap.ContainsKey(p) then        // 直接返回智能指针        Result := TAutoPtr<T>(fObjMap.Items[p]) as IAutoPtr<T>    else        Result := TAutoPtr<T>.Create(aObj) as IAutoPtr<T>;end;function TAutoPtr<T>.Release: T;begin    Result := fObj;    // fObj := nil    Integer((@fObj)^) := 0;end;procedure TAutoPtr<T>.Reset(aObj: T);begin    // aObj <> fObj then    if Integer((@aObj)^) <> Integer((@fObj)^) then    begin        FreeObj;        fObj := aObj;    end;end;destructor TAutoPtr<T>.Destroy;begin    // if fObj = nil then..    if Integer((@fObj)^) <> 0 then        FreeObj;    fTypeInfo := nil;    inherited;end;procedure TAutoPtr<T>.FreeObj;begin    // 此处如果TypeInfo为空,则说明T为Pointer    // 此处只要简单的释放内存即可    if fTypeInfo = nil then        //FreeMem(Pointer((@fObj)^))        // 此处应该调用Dispose,因为Dispose内部已经实现FreeMem:        // PUSH    EAX        // CALL    _Finalize        // POP     EAX        // CALL    _FreeMem        Dispose(Pointer((@fObj)^))    else    begin        case fTypeInfo.Kind of            tkClass:                // 调用Object.Free,进而调用Destructor Dispose(virtual)方法                // 实现在对象树上的遍历释放                TObject((@fObj)^).Free;            tkArray, tkDynArray:                // 数组和动态数组无需释放        end;    end;    // fobj := nil;    Integer((@fObj)^) := 0;end;function TAutoPtr<T>.Get: T;begin    Result := fObj;end;class function TAutoPtr<T>.New: IAutoPtr<T>;var    typInfo: PTypeInfo;    obj: TObject;    objNew: T;    typData: PTypeData;begin    typInfo := TypeInfo(T);    // 在此处只能创建class型的指针,不能创建无类型指针    // 因为指针在Delphi中有两种初始化方式    // 1、GetMem(p, 100);    // 2、New(p);    if (typInfo <> nil) and (typInfo.Kind = tkClass) then    begin        typData := GetTypeData(typInfo);        Writeln(typData.ClassType.ClassName);        TClass.Create;        // 获取T的类型并调用默认构造函数创建对象        obj := GetTypeData(typInfo).ClassType.Create;        // 使用以下方法强制转换        objNew := T((@obj)^);        Exit(New(objNew));    end;    raise Exception.Create('只能构造class型的对象。');end;initializationfObjMap := TDictionary<Pointer, Pointer>.Create;finalizationfObjMap.Free;end.


原创粉丝点击