How can I cast an object to a generic?

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

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;

Answer 2

The answer above from Andreas is brilliant. It's really helped my use of generics in Delphi. Please then forgive me Andreas as I wonder if DynamicCast is a little complicated. Please correct me if I'm wrong but the following should be a little more concise, safe, fast (no string comparisons) and still as functional.

Really all I've done is use the class constraint on the DynamicCast type params to allow the compiler to do a bit of work (as the original will always except with non-class parameters) and then use the TObject.InheritsFrom function to check for type compatibility.

I've also found the idea of a TryCast function quite useful (it's a common task for me anyway!)

This is of course unless I've missed the point somewhere in trawling the class parents for matching names... which IMHO is a little dangerous given that type names may match for non compatible classes in different scopes.

Anyway, here's my code (works for Delphi XE3... D2009 compatible version of TryCast follows after).

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;
    // Attempt a dynamic cast, returning True if successful
    class function TryCast<T, ReturnT: class>(const Value: T; out Return: ReturnT): Boolean;
    // DynamicCast is like the as-operator. It checks if the object can be typecasted
    class function DynamicCast<T, ReturnT: class>(const Value: T): ReturnT;
  end;

implementation

uses
  System.SysUtils;


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.TryCast<T, ReturnT>(const Value: T; out Return: ReturnT): Boolean;
begin
  Result := (not Assigned(Value)) or Value.InheritsFrom(ReturnT);
  if Result then
    Return := ReinterpretCast<ReturnT>(Value);
end;

class function TTypeCast.DynamicCast<T, ReturnT>(const Value: T): ReturnT;
begin
  if not TryCast<T, ReturnT>(Value, Result) then
    //Value will definately be assigned is TryCast returns false
    raise EInvalidCast.CreateFmt('Invalid class typecast from %s(%s) to %s',
      [T.ClassName, Value.ClassName, ReturnT.ClassName]);
end;

As promised the D2009 version (needs some small effort to get to the class of ReturnT).

class function TTypeCast.TryCast<T, ReturnT>(const Value: T; out Return: ReturnT): Boolean;
var
  LReturnTypeInfo: PTypeInfo;
  LReturnClass: TClass;
begin
  Result := True;
  if not Assigned(Value) then
    Return := Default(ReturnT)
  else
  begin
    LReturnTypeInfo := TypeInfo(ReturnT);
    LReturnClass := GetTypeData(LReturnTypeInfo).ClassType;
    if Value.InheritsFrom(LReturnClass) then
      Return := ReinterpretCast<ReturnT>(Value)
    else
      Result := False;
  end;
end;