Delphi RTTI 'Invalid class typecast' when assigning property of record type

204 Views Asked by At

I'm using a Delphi record type to store a Double value and then defining Implicit operators to handle assignment & conversion to different types. Everything works great for simple operations, however when using RTTI it bombs out with an invalid typecast when trying to assign the record type to another object. I'm trying to create a generic mapping class so that I can iterate over all properties and assign them using RTTI, but I'm stuck on this issue. Code sample provided below with exception line marked...

program RecordAssigner;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.Rtti,
  System.SysUtils;

type

  TLength = record
  private
    FValue: Double;
  public
    class operator Implicit(A: Double): TLength;
    class operator Implicit(A: TLength): Double;
    class operator Implicit(A: TLength): string;
    class operator Implicit(A: string): TLength;
  end;

  TMyClassNormal = class
  private
    FMyDouble: Double;
    FMyLength: TLength;
  public
    property MyDouble: Double read FMyDouble write FMyDouble;
    property MyLength: TLength read FMyLength write FMyLength;
  end;

  TMyClassInverted = class
  private
    FMyDouble: TLength;
    FMyLength: Double;
  public
    property MyDouble: TLength read FMyDouble write FMyDouble;
    property MyLength: Double read FMyLength write FMyLength;
  end;

class operator TLength.Implicit(A: Double): TLength;
begin
  Result.FValue := A;
end;

class operator TLength.Implicit(A: TLength): Double;
begin
  Result := A.FValue;
end;

class operator TLength.Implicit(A: string): TLength;
begin
  Result.FValue := StrToFloat(A);
end;

class operator TLength.Implicit(A: TLength): string;
begin
  Result := Format('%f inches', [A.FValue]);
end;

procedure WriteObject(ANormalObject: TMyClassNormal; AInvertedObject: TMyClassInverted; APass: string);
begin
  Writeln('Pass #', APass);
  Writeln('Normal Class Double: ', FloatToStr(ANormalObject.MyDouble));
  Writeln('Normal Class Length: ', FloatToStr(ANormalObject.MyLength));
  Writeln('Normal Class Length (as string): ', string(ANormalObject.MyLength));
  Writeln('Inverted Class Double: ', FloatToStr(AInvertedObject.MyDouble));
  Writeln('Inverted Class Double (as string): ', string(AInvertedObject.MyDouble));
  Writeln('Inverted Class Length: ', FloatToStr(AInvertedObject.MyLength));
  Writeln('');
end;

var
  LNormalObject: TMyClassNormal;
  LInvertedObject: TMyClassInverted;

  LContext: TRttiContext;
  SourceType: TRttiType;
  LTargetProp: TRttiProperty;
begin
  LNormalObject := TMyClassNormal.Create;
  LInvertedObject := TMyClassInverted.Create;
  try
    try
      LNormalObject.MyDouble := 1;
      LNormalObject.MyLength := 2;
      LInvertedObject.MyDouble := LNormalObject.MyDouble;
      LInvertedObject.MyLength := LNormalObject.MyLength;
      WriteObject(LNormalObject, LInvertedObject, '1');

      LNormalObject.MyDouble := 3;
      LNormalObject.MyLength := '4';
      LInvertedObject.MyDouble := LNormalObject.MyDouble;
      LInvertedObject.MyLength := LNormalObject.MyLength;
      WriteObject(LNormalObject, LInvertedObject, '2');

      LNormalObject.MyDouble := 5;
      LNormalObject.MyLength := 6;

      SourceType := LContext.GetType(LNormalObject.ClassInfo);
      for LTargetProp in LContext.GetType(LInvertedObject.ClassInfo).GetProperties do
        LTargetProp.SetValue(LInvertedObject, SourceType.GetProperty(LTargetProp.Name).GetValue(LNormalObject));   // FAILING HERE

      WriteObject(LNormalObject, LInvertedObject, '3');

      Readln;
    except
      on E: Exception do
        Writeln(E.ClassName, ': ', E.Message);
    end;
  finally
    LNormalObject.Free;
    LInvertedObject.Free;
  end;

  ReportMemoryLeaksOnShutdown := True;
end.
2

There are 2 best solutions below

8
Stefan Glienke On BEST ANSWER

The reason is trivial: the type conversion in TValue does not consider operator overloads. However, in Spring4D there is a type helper for TValue that provides conversion methods. These conversions provide various conversions between types that are not assignment compatible such as from and to string conversions. On top of that they can use the value converters but you need to explicitly connect the ValueConverterCallback for that to work as well as registering value converters for your type:

type
  TLengthToDoubleConverter = class(TValueConverter)
    function DoConvertTo(const value: TValue; const targetTypeInfo: PTypeInfo;
      const parameter: TValue): TValue; override;
  end;

  TDoubleToLengthConverter = class(TValueConverter)
    function DoConvertTo(const value: TValue; const targetTypeInfo: PTypeInfo;
      const parameter: TValue): TValue; override;
  end;

function TLengthToDoubleConverter.DoConvertTo(const value: TValue;
  const targetTypeInfo: PTypeInfo; const parameter: TValue): TValue;
begin
  Result := Double(value.AsType<TLength>);
end;

function TDoubleToLengthConverter.DoConvertTo(const value: TValue;
  const targetTypeInfo: PTypeInfo; const parameter: TValue): TValue;
begin
  Result := TValue.From<TLength>(value.AsType<Double>);
end;

function TryConvertTo(const value: TValue; const targetTypeInfo: PTypeInfo;
  var targetValue: TValue; const parameter: TValue): Boolean;
begin
  Result := TValueConverter.Default.TryConvertTo(value, targetTypeInfo, targetValue, parameter);
end;

procedure InitConverters;
begin
  TValue.ValueConverterCallback := TryConvertTo;
end;

begin
  TValue.ValueConverterCallback := TryConvertTo;
  TValueConverterFactory.RegisterConverter(TypeInfo(TLength), TypeInfo(Double), TLengthToDoubleConverter);
  TValueConverterFactory.RegisterConverter(TypeInfo(Double), TypeInfo(TLength), TDoubleToLengthConverter);

  ...

  for LTargetProp in LContext.GetType(LInvertedObject.ClassInfo).GetProperties do
    LTargetProp.SetValue(LInvertedObject, SourceType.GetProperty(LTargetProp.Name).GetValue(LNormalObject).Convert(LTargetProp.PropertyType.Handle));

However, that can become a little tedious when you already have the code to perform this conversion in the form of the implicit operators so I just implemented support for using them in TValue.TryConvert - please look into the branch feature/implicit_conversion. If that feature turns out to be usable I will merge it to develop.

0
Rick Wheeler On

After further work on the above, came up with a not so elegant but working solution. Maybe this is the only way known of achieving the result anyway:

  for LTargetProp in LContext.GetType(LInvertedObject.ClassInfo).GetProperties do
  begin
    if LTargetProp.PropertyType.Name = 'TLength' then
    begin
      LLength := TLength.Create(SourceType.GetProperty(LTargetProp.Name).GetValue(LNormalObject).AsType<Double>);
      TValue.Make(@LLength, TypeInfo(TLength), LValue);
      LTargetProp.SetValue(LInvertedObject, LValue);
    end
    else
    begin
      LLength := SourceType.GetProperty(LTargetProp.Name).GetValue(LNormalObject).AsType<TLength>;
      LDouble := LLength;
      TValue.Make(@LDouble, TypeInfo(Double), LValue);
      LTargetProp.SetValue(LInvertedObject, LValue);
    end;
  end;

Any other ideas or improvements are welcomed... PLEASE SEE MY COMMENT ABOVE RE: Spring4D. I would love to use the TValueConverters for this requirement as I'm positive this is what they were built for.