¿Cómo puedo convertir un objeto en un genérico?

Question

Estoy tratando de convertir un objeto base devuelto a su tipo genérico específico. El código siguiente debería funcionar, creo, pero genera un error interno del compilador, ¿hay alguna otra forma de hacerlo?

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

Estoy usando una clase de ayuda tipocast que hace los tipos de letra y también comprueba si las dos clases son compatibles.

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; 

Aquí es la clase:

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

La respuesta anterior de Andreas es brillante. Realmente ayudó mi uso de los genéricos en Delphi. Por favor, perdónenme, Andreas, ya que me pregunto si DynamicCast es un poco complicado. Por favor corrígeme si me equivoco, pero lo siguiente debe ser un poco más conciso, seguro, rápido (sin comparaciones de cadenas) y sigue siendo funcional.

Realmente todo lo que he hecho es utilizar la restricción de clase en los params de tipo DynamicCast para permitir que el compilador trabaje un poco (como el original siempre excepto con parámetros que no sean de clase) y luego usar TObject.InheritsFrom función para verificar la compatibilidad del tipo.

También he encontrado la idea de una función TryCast bastante útil (que es una tarea común para mí de todos modos!)

Esto es, por supuesto, a menos que me he perdido el punto en algún lugar de la pesca de arrastre de los padres de la clase para hacer coincidir nombres ... que en mi humilde opinión es un poco peligroso dado que los nombres de tipo pueden coincidir con las clases no compatibles en diferentes ámbitos.

De todos modos, aquí está mi código (a continuación, funciona la versión compatible con Delphi XE3 ... D2009 de TryCast).

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; 

Según lo prometido, la versión D2009 (necesita un pequeño esfuerzo para llegar a la clase de 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;