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