FreePascal 中的通用 Class 工厂
Generic Class factory in FreePascal
无法使此通用 class 工厂工作:
{
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; version 2 of the License.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
}
// Copyright (c) 2010 2011 2012 2013 2014 2015 - J. Aldo G. de Freitas Junior
{$mode objfpc}
{$H+}{$M+}
Unit
GenericClassFactory;
Interface
Uses
{$ifdef unix}
cthreads,
cmem,
{$endif}
SysUtils,
Contnrs,
RTTIObjects;
Type
EGenericClassFactory = Class(Exception);
Generic GGenericClassFactory<ObjectType> = Class
Type
TGenericType = ObjectType;
TGenericTypeClass = Class Of TGenericType;
Private
fMutex : TMultiReadExclusiveWriteSynchronizer;
fHashTable : TFPHashList;
Public
Constructor Create;
Destructor Destroy; Override;
Procedure Register(Const aClass : TClass; Const aName : String = '');
Function Build(Const aName : String): TGenericType;
End;
Implementation
Constructor GGenericClassFactory.Create;
Begin
Inherited;
fMutex := TMultiReadExclusiveWriteSynchronizer.Create;
fHashTable := TFPHashList.Create;
End;
Destructor GGenericClassFactory.Destroy;
Begin
FreeAndNil(fMutex);
FreeAndNil(fHashTable);
Inherited;
End;
Procedure GGenericClassFactory.Register(Const aClass : TClass; Const aName : String = '');
Begin
Try
fMutex.BeginWrite;
If aName = '' Then
fHashTable.Add(aClass.ClassName, Pointer(aClass))
Else
fHashTable.Add(aName, aClass);
Finally
fMutex.EndWrite;
End;
End;
Function GGenericClassFactory.Build(Const aName : String): TGenericType;
Var
lIndex : Integer;
Begin
Try
fMutex.BeginRead;
lIndex := fHashTable.FindIndexOf(aName);
If lIndex >= 0 Then
Begin
Build := TGenericTypeClass(fHashTable.Items[lIndex]).Create;
End
Else
Raise EGenericClassFactory.Create('Type ' + aName + ' is not registered in this class factory.');
Finally
fMutex.EndRead;
End;
End;
End.
编译器声明:
Free Pascal Compiler version 2.6.4 [2014/03/06] for i386
Copyright (c) 1993-2014 by Florian Klaempfl and others
Target OS: Win32 for i386
Compiling CustomActorMessages.pas
Compiling GenericClassFactory.pas
GenericClassFactory.pas(37,23) Error: class type expected, but got "<undefined type>"
GenericClassFactory.pas(48,1) Fatal: There were 1 errors compiling module, stopping
Fatal: Compilation aborted
尝试同时使用 TGenericTypeClass
作为类型强制和 (TClass.Create As ObjectType
) 无济于事。两者都给出相同的错误。没有 return 正确类型的通用 class 工厂不是很有用。
第 TGenericTypeClass = Class Of TGenericType;
.
行出错
您不能为任何 ObjectType
声明 class of
。
简单代码生成相同的错误:
type
generic TGenFoo<T> = class
type
TGenClass = class of T;
end;
真的,对于T
= integer
声明class of integer
没有任何意义。
所以你需要声明 T
有一些限制:
type
generic TGenFoo<T: TObject> = class
type
TGenClass = class of T;
end;
编译正常。
FPC 3.1.1
无法使此通用 class 工厂工作:
{
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; version 2 of the License.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
}
// Copyright (c) 2010 2011 2012 2013 2014 2015 - J. Aldo G. de Freitas Junior
{$mode objfpc}
{$H+}{$M+}
Unit
GenericClassFactory;
Interface
Uses
{$ifdef unix}
cthreads,
cmem,
{$endif}
SysUtils,
Contnrs,
RTTIObjects;
Type
EGenericClassFactory = Class(Exception);
Generic GGenericClassFactory<ObjectType> = Class
Type
TGenericType = ObjectType;
TGenericTypeClass = Class Of TGenericType;
Private
fMutex : TMultiReadExclusiveWriteSynchronizer;
fHashTable : TFPHashList;
Public
Constructor Create;
Destructor Destroy; Override;
Procedure Register(Const aClass : TClass; Const aName : String = '');
Function Build(Const aName : String): TGenericType;
End;
Implementation
Constructor GGenericClassFactory.Create;
Begin
Inherited;
fMutex := TMultiReadExclusiveWriteSynchronizer.Create;
fHashTable := TFPHashList.Create;
End;
Destructor GGenericClassFactory.Destroy;
Begin
FreeAndNil(fMutex);
FreeAndNil(fHashTable);
Inherited;
End;
Procedure GGenericClassFactory.Register(Const aClass : TClass; Const aName : String = '');
Begin
Try
fMutex.BeginWrite;
If aName = '' Then
fHashTable.Add(aClass.ClassName, Pointer(aClass))
Else
fHashTable.Add(aName, aClass);
Finally
fMutex.EndWrite;
End;
End;
Function GGenericClassFactory.Build(Const aName : String): TGenericType;
Var
lIndex : Integer;
Begin
Try
fMutex.BeginRead;
lIndex := fHashTable.FindIndexOf(aName);
If lIndex >= 0 Then
Begin
Build := TGenericTypeClass(fHashTable.Items[lIndex]).Create;
End
Else
Raise EGenericClassFactory.Create('Type ' + aName + ' is not registered in this class factory.');
Finally
fMutex.EndRead;
End;
End;
End.
编译器声明:
Free Pascal Compiler version 2.6.4 [2014/03/06] for i386
Copyright (c) 1993-2014 by Florian Klaempfl and others
Target OS: Win32 for i386
Compiling CustomActorMessages.pas
Compiling GenericClassFactory.pas
GenericClassFactory.pas(37,23) Error: class type expected, but got "<undefined type>"
GenericClassFactory.pas(48,1) Fatal: There were 1 errors compiling module, stopping
Fatal: Compilation aborted
尝试同时使用 TGenericTypeClass
作为类型强制和 (TClass.Create As ObjectType
) 无济于事。两者都给出相同的错误。没有 return 正确类型的通用 class 工厂不是很有用。
第 TGenericTypeClass = Class Of TGenericType;
.
您不能为任何 ObjectType
声明 class of
。
简单代码生成相同的错误:
type
generic TGenFoo<T> = class
type
TGenClass = class of T;
end;
真的,对于T
= integer
声明class of integer
没有任何意义。
所以你需要声明 T
有一些限制:
type
generic TGenFoo<T: TObject> = class
type
TGenClass = class of T;
end;
编译正常。
FPC 3.1.1