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

于 2011-08-09 18:39:04 发布
阅读量1k 收藏 1
点赞数
分类专栏： Delphi 文章标签： delphi 语言 constructor destructor integer class

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;

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.

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

----------------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;

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.

 测试结果为：

----------------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     private
11            fObj: T;
12     public
13            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 implementation
22 
23 { TAutoPtr<T> }
24 
25 constructor TAutoPtr<T>.Create(aObj: T);
26 begin
27     fObj := aObj;
28 end;
29 
30 class function TAutoPtr<T>.New(aObj: T): IAutoPtr<T>;
31 begin
32     Result := TAutoPtr<T>.Create(aObj) as IAutoPtr<T>; // 注意：此处如果不加as IAutoPtr<T>，程序运行时会报错，第一次我没有加as IAutoPtr<T>程序运行一切正常，到后面就不行了，不知道是为什么
33 end;
34 
35 function TAutoPtr<T>.Release: T;
36 begin
37     Result := fObj;
38     fObj := nil;
39 end;
40 
41 procedure TAutoPtr<T>.Reset(aObj: T);
42 begin
43     if aObj <> fObj then
44     begin
45         FreeAndNil(fObj);
46         fObj := aObj;
47     end;
48 end;
49 
50 destructor TAutoPtr<T>.Destroy;
51 begin
52     if fObj <> nil then
53     begin
54         FreeAndNil(fObj);
55     end;
56     
57     inherited;
58 end;
59 
60 function TAutoPtr<T>.Get: T;
61 begin
62     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;

interface

uses
    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;

interface

uses
    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;

initialization

fObjMap := TDictionary<Pointer, Pointer>.Create;

finalization

fObjMap.Free;

end.


space_ss
关注
  • 0
    点赞
  • 踩
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值