基于无约束泛型类型创建对象实例

Question

我有无约束的泛型类型Atomic,它实现了一个初始化器(我之前的问题中的细节).

type
  Atomic<T> = class
    type TFactory = reference to function: T;
    class function Initialize(var storage: T; factory: TFactory): T;
  end;

现在我想编写简化的Initialize函数,该函数将从T获取类型信息(假设typeof(T)是tkClass)并使用默认构造函数创建新实例(必要时).

可悲的是,这失败了:

class function Atomic<T>.Initialize(var storage: T): T;
begin
  if not assigned(PPointer(@storage)^) then begin
    if PTypeInfo(TypeInfo(T))^.Kind  <> tkClass then
      raise Exception.Create('Atomic<T>.Initialize: Unsupported type');
    Result := Atomic<T>.Initialize(storage,
      function: T
      begin
        Result := TClass(T).Create; // <-- E2571
      end);
  end;
end;

编译器报告错误E2571 Type parameter 'T' doesn't have class or interface constraint.

如何欺骗编译器创建类T的实例？

Answer 1

您可以使用GetTypeData获取类引用:

Result := T(GetTypeData(PTypeInfo(TypeInfo(T)))^.ClassType.Create);

在Delphi XE2中(希望在下一版本中),您可以:

var
  xInValue, xOutValue: TValue;

xInValue := GetTypeData(PTypeInfo(TypeInfo(T)))^.ClassType.Create;
xInValue.TryCast(TypeInfo(T), xOutValue);
Result := xOutValue.AsType<T>;

(这种相当规避的方式是cjsalamon在OmniThreadLibrary论坛中使用的:OtlSync XE2中的错误.)

Answer 2

您可以使用新的Delphi Rtti来完成此任务.给定解决方案的缺点是,如果构造函数未命名为Create,则它将无法工作.如果你需要让它一直工作,只需枚举你的类型方法,检查它是否是一个构造函数并且有0个参数,然后调用它.适用于Delphi XE.示例代码:

class function TTest.CreateInstance<T>: T;
var
  AValue: TValue;
  ctx: TRttiContext;
  rType: TRttiType;
  AMethCreate: TRttiMethod;
  instanceType: TRttiInstanceType;
begin
  ctx := TRttiContext.Create;
  rType := ctx.GetType(TypeInfo(T));
  AMethCreate := rType.GetMethod('Create');

  if Assigned(AMethCreate) and rType.IsInstance then
  begin
    instanceType := rType.AsInstance;

    AValue := AMethCreate.Invoke(instanceType.MetaclassType, []);// create parameters

    Result := AValue.AsType<T>;
  end;
end;

更新的方案:

class function TTest.CreateInstance<T>: T;
var
  AValue: TValue;
  ctx: TRttiContext;
  rType: TRttiType;
  AMethCreate: TRttiMethod;
  instanceType: TRttiInstanceType;
begin
  ctx := TRttiContext.Create;
  rType := ctx.GetType(TypeInfo(T));
  for AMethCreate in rType.GetMethods do
  begin
    if (AMethCreate.IsConstructor) and (Length(AMethCreate.GetParameters) = 0) then
    begin
      instanceType := rType.AsInstance;

      AValue := AMethCreate.Invoke(instanceType.MetaclassType, []);

      Result := AValue.AsType<T>;

      Exit;
    end;
  end;
end;

并称之为:

var
  obj: TTestObj;
begin
  obj := TTest.CreateType<TTestObj>;