Question

I’m trying to cast a returned base object to it’s specific generic type. The code below should work I think but generates an internal compiler error, is there another way to do this?

type
  TPersistGeneric<T> = class
  private
  type
    TPointer = ^T;
  public
    class function  Init : T;
  end;

class function  TPersistGeneric<T>.Init : T;
var
  o : TXPersistent; // root class
begin
  case PTypeInfo(TypeInfo(T))^.Kind of
    tkClass : begin
                // xpcreate returns txpersistent, a root class of T
                o := XPCreate(GetTypeName(TypeInfo(T))); // has a listed of registered classes
                result := TPointer(pointer(@o))^;
              end;
    else
      result := Default(T);
  end;
end;

Answer 1

I’m using a typecast helper class that does the typecasts and also checks if the two classes are compatible.

class function TPersistGeneric<T>.Init: T;
var
  o : TXPersistent; // root class
begin
  case PTypeInfo(TypeInfo(T))^.Kind of
    tkClass : begin
                // xpcreate returns txpersistent, a root class of T
                o := XPCreate(GetTypeName(TypeInfo(T))); // has a listed of registered classes
                Result := TTypeCast.DynamicCast<TXPersistent, T>(o);
              end;
    else
      result := Default(T);
  end;

Here is the class:

type
  TTypeCast = class
  public
    // ReinterpretCast does a hard type cast
    class function ReinterpretCast<ReturnT>(const Value): ReturnT;
    // StaticCast does a hard type cast but requires an input type
    class function StaticCast<T, ReturnT>(const Value: T): ReturnT;
    // DynamicCast is like the as-operator. It checks if the object can be typecasted
    class function DynamicCast<T, ReturnT>(const Value: T): ReturnT;
  end;

class function TTypeCast.ReinterpretCast<ReturnT>(const Value): ReturnT;
begin
  Result := ReturnT(Value);
end;

class function TTypeCast.StaticCast<T, ReturnT>(const Value: T): ReturnT;
begin
  Result := ReinterpretCast<ReturnT>(Value);
end;

class function TTypeCast.DynamicCast<T, ReturnT>(const Value: T): ReturnT;
var
  TypeT, TypeReturnT: PTypeInfo;
  Obj: TObject;
  LClass: TClass;
  ClassNameReturnT, ClassNameT: string;
  FoundReturnT, FoundT: Boolean;
begin
  TypeT := TypeInfo(T);
  TypeReturnT := TypeInfo(ReturnT);
  if (TypeT = nil) or (TypeReturnT = nil) then
    raise Exception.Create('Missing Typeinformation');
  if TypeT.Kind <> tkClass then
    raise Exception.Create('Source type is not a class');
  if TypeReturnT.Kind <> tkClass then
    raise Exception.Create('Destination type is not a class');

  Obj := TObject(Pointer(@Value)^);
  if Obj = nil then
    Result := Default(ReturnT)
  else
  begin
    ClassNameReturnT := UTF8ToString(TypeReturnT.Name);
    ClassNameT := UTF8ToString(TypeT.Name);
    LClass := Obj.ClassType;
    FoundReturnT := False;
    FoundT := False;
    while (LClass <> nil) and not (FoundT and FoundReturnT) do
    begin
      if not FoundReturnT and (LClass.ClassName = ClassNameReturnT) then
        FoundReturnT := True;
      if not FoundT and (LClass.ClassName = ClassNameT) then
        FoundT := True;
      LClass := LClass.ClassParent;
    end;
    //if LClass <> nil then << TObject doesn't work with this line
    if FoundT and FoundReturnT then
      Result := ReinterpretCast<ReturnT>(Obj)
    else
    if not FoundReturnT then
      raise Exception.CreateFmt('Cannot cast class %s to %s',
                                [Obj.ClassName, ClassNameReturnT])
    else
      raise Exception.CreateFmt('Object (%s) is not of class %s',
                                [Obj.ClassName, ClassNameT]);
  end;
end;