FreePascal中的通用类工厂

时间:2015-04-21 17:41:23

标签: pascal freepascal lazarus

无法使此通用类工厂工作:

{
  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)无济于事。两者都给出了同样的错误。没有返回正确类型的泛型类工厂不是很有用。

1 个答案:

答案 0 :(得分:3)

TGenericTypeClass = Class Of TGenericType;行的错误。

您无法为任何class of声明ObjectType。 简单代码生成相同的错误:

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