• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

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

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

一、弊端

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

 

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

 

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

IAutoPtr<T: class> = interface(IInterface)

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

二、提出问题

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

首先贴出原来的代码:

;

 

 

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 <> niland (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 <> niland (typInfo.Kind = tkClass) then
    
begin
        
// 获取T的类型并调用默认构造函数创建对象
        obj :
= GetTypeData(typInfo).ClassType.Create;

        
// 使用以下方法强制转换
        objNew :
= T((@obj)^);
        Exit(New(objNew));
    
end;

    
raise Exception.Create('只能构造class型的对象。');
end;

end.

 

 


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
Delphi2009泛型容器单元(Generics.Collections)[1]:TListT发布时间:2022-07-18
下一篇:
黄聪:Delphi实现软件中登录用户的操作权限发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap