* Patch from Евгений Савин to implement TValue.Cast for floats. Fixes issue #41011

packages/rtl-objpas/src/inc/rtti.pp

@@ -2612,11 +2612,26 @@ Procedure TValue.CastIntegerToFloat(out aRes : Boolean; out ADest: TValue; aDest
 var
   Tmp : Int64;
   Ti : PtypeInfo;
-
+  DestFloatType: TFloatType;
+  S: Single;
+  D: Double;
+  E: Extended;
+  Co: Comp;
+  Cu: Currency;
 begin
   Tmp:=AsInt64;
-  Ti:=FloatTypeToTypeInfo(GetTypeData(aDestType)^.FloatType);
-  TValue.Make(@Tmp,Ti,aDest);
+  DestFloatType := GetTypeData(aDestType)^.FloatType;
+  Ti:=FloatTypeToTypeInfo(DestFloatType);
+  case DestFloatType of
+    ftSingle:   begin S  := Tmp; TValue.Make(@S, Ti,aDest); end;
+    ftDouble:   begin D  := Tmp; TValue.Make(@D, Ti,aDest); end;
+    ftExtended: begin E  := Tmp; TValue.Make(@E, Ti,aDest); end;
+    ftComp:     begin Co := Tmp; TValue.Make(@Co,Ti,aDest); end;
+    ftCurr:     begin Cu := Tmp; TValue.Make(@Cu,Ti,aDest); end;
+  else
+    aRes := False;
+    Exit;
+  end;
   aRes:=True;
 end;
 
@@ -2758,35 +2773,66 @@ var
   E : Extended;
   Co : Comp;
   Cu : Currency;
-
+  DestFloatType: TFloatType;
 begin
   // Destination float type
-  ti:=FloatTypeToTypeInfo(GetTypeData(aDestType)^.FloatType);
+  DestFloatType := GetTypeData(aDestType)^.FloatType;
+  ti:=FloatTypeToTypeInfo(DestFloatType);
   case TypeData^.FloatType of
     ftSingle:
       begin
       S:=AsSingle;
-      TValue.Make(@S,Ti,aDest);
+      case DestFloatType of
+        ftSingle:   begin          TValue.Make(@S, Ti,aDest); end;
+        ftDouble:   begin D := S;  TValue.Make(@D, Ti,aDest); end;
+        ftExtended: begin E := S;  TValue.Make(@E, Ti,aDest); end;
+        ftComp:     begin Co := S; TValue.Make(@Co,Ti,aDest); end;
+        ftCurr:     begin Cu := S; TValue.Make(@Cu,Ti,aDest); end;
+      end;
       end;
     ftDouble:
       begin
       D:=AsDouble;
-      TValue.Make(@D,Ti,aDest);
+      case DestFloatType of
+        ftSingle:   begin S  := D; TValue.Make(@S, Ti,aDest); end;
+        ftDouble:   begin          TValue.Make(@D, Ti,aDest); end;
+        ftExtended: begin E  := D; TValue.Make(@E, Ti,aDest); end;
+        ftComp:     begin Co := D; TValue.Make(@Co,Ti,aDest); end;
+        ftCurr:     begin Cu := D; TValue.Make(@Cu,Ti,aDest); end;
+      end;
       end;
     ftExtended:
       begin
       E:=AsExtended;
-      TValue.Make(@E,Ti,aDest);
+      case DestFloatType of
+        ftSingle:   begin S  := E; TValue.Make(@S, Ti,aDest); end;
+        ftDouble:   begin D  := E; TValue.Make(@D, Ti,aDest); end;
+        ftExtended: begin          TValue.Make(@E, Ti,aDest); end;
+        ftComp:     begin Co := E; TValue.Make(@Co,Ti,aDest); end;
+        ftCurr:     begin Cu := E; TValue.Make(@Cu,Ti,aDest); end;
+      end;
       end;
     ftComp:
       begin
       Co:=FData.FAsComp;
-      TValue.Make(@Co,Ti,aDest);
+      case DestFloatType of
+        ftSingle:   begin S  := Co; TValue.Make(@S, Ti,aDest); end;
+        ftDouble:   begin D  := Co; TValue.Make(@D, Ti,aDest); end;
+        ftExtended: begin E  := Co; TValue.Make(@E, Ti,aDest); end;
+        ftComp:     begin           TValue.Make(@Co,Ti,aDest); end;
+        ftCurr:     begin Cu := Co; TValue.Make(@Cu,Ti,aDest); end;
+      end;
       end;
     ftCurr:
       begin
       Cu:=AsCurrency;
-      TValue.Make(@Cu,Ti,aDest);
+      case DestFloatType of
+        ftSingle:   begin S  := Cu; TValue.Make(@S, Ti,aDest); end;
+        ftDouble:   begin D  := Cu; TValue.Make(@D, Ti,aDest); end;
+        ftExtended: begin E  := Cu; TValue.Make(@E, Ti,aDest); end;
+        ftComp:     begin Co := Cu; TValue.Make(@Co,Ti,aDest); end;
+        ftCurr:     begin           TValue.Make(@Cu,Ti,aDest); end;
+      end;
       end;
     end;
   aRes:=True;
@@ -7853,4 +7899,4 @@ initialization
 {$ifdef SYSTEM_HAS_INVOKE}
   InitSystemFunctionCallManager;
 {$endif}
-end.
+end.

tests/webtbs/tw41011.pp

@@ -0,0 +1,50 @@
+program tw41011;
+{$mode DELPHI}
+uses
+  Rtti
+  ;
+
+var
+  ErrorCount: Integer;
+
+procedure AreEqual(const AExpected, AActual: Double; const AMessage: string);
+begin
+  if Abs(AExpected - AActual) > 0.001 then
+  begin
+    WriteLn(AExpected, ' <> ', AActual, ': ', AMessage);
+    Inc(ErrorCount);
+  end;
+end;
+
+begin
+  AreEqual(-10, TValue.From<Int8>(-10).Cast<Single>().AsType<Single>, 'TValue.From<Int8>(-10).Cast<Single>().AsType<Single>');
+  AreEqual(205, TValue.From<UInt8>(205).Cast<Single>().AsType<Single>, 'TValue.From<UInt8>(205).Cast<Single>().AsType<Single>');
+  AreEqual(-30012, TValue.From<Int16>(-30012).Cast<Single>().AsType<Single>, 'TValue.From<Int16>(-30012).Cast<Single>().AsType<Single>');
+  AreEqual(60123, TValue.From<UInt16>(60123).Cast<Single>().AsType<Single>, 'TValue.From<UInt16>(60123).Cast<Single>().AsType<Single>');
+  AreEqual(-12, TValue.From<Int32>(-12).Cast<Single>().AsType<Single>, 'TValue.From<Int32>(-12).Cast<Single>().AsType<Single>');
+  AreEqual(42, TValue.From<Int32>(42).Cast<Single>().AsType<Single>, 'TValue.From<Int32>(42).Cast<Single>().AsType<Single>');
+
+  AreEqual(-10, TValue.From<Int8>(-10).Cast<Double>().AsType<Double>, 'TValue.From<Int8>(-10).Cast<Double>().AsType<Double>');
+  AreEqual(205, TValue.From<UInt8>(205).Cast<Double>().AsType<Double>, 'TValue.From<UInt8>(205).Cast<Double>().AsType<Double>');
+  AreEqual(-30012, TValue.From<Int16>(-30012).Cast<Double>().AsType<Double>, 'TValue.From<Int16>(-30012).Cast<Double>().AsType<Double>');
+  AreEqual(60123, TValue.From<UInt16>(60123).Cast<Double>().AsType<Double>, 'TValue.From<UInt16>(60123).Cast<Double>().AsType<Double>');
+  AreEqual(-12, TValue.From<Int32>(-12).Cast<Double>().AsType<Double>, 'TValue.From<Int32>(-12).Cast<Double>().AsType<Double>');
+  AreEqual(42, TValue.From<Int32>(42).Cast<Double>().AsType<Double>, 'TValue.From<Int32>(42).Cast<Double>().AsType<Double>');
+
+  AreEqual(-10, TValue.From<Int8>(-10).Cast<Extended>().AsType<Extended>, 'TValue.From<Int8>(-10).Cast<Extended>().AsType<Extended>');
+  AreEqual(205, TValue.From<UInt8>(205).Cast<Extended>().AsType<Extended>, 'TValue.From<UInt8>(205).Cast<Extended>().AsType<Extended>');
+  AreEqual(-30012, TValue.From<Int16>(-30012).Cast<Extended>().AsType<Extended>, 'TValue.From<Int16>(-30012).Cast<Extended>().AsType<Extended>');
+  AreEqual(60123, TValue.From<UInt16>(60123).Cast<Extended>().AsType<Extended>, 'TValue.From<UInt16>(60123).Cast<Extended>().AsType<Extended>');
+  AreEqual(-12, TValue.From<Int32>(-12).Cast<Extended>().AsType<Extended>, 'TValue.From<Int32>(-12).Cast<Extended>().AsType<Extended>');
+  AreEqual(42, TValue.From<Int32>(42).Cast<Extended>().AsType<Extended>, 'TValue.From<Int32>(42).Cast<Extended>().AsType<Extended>');
+
+  AreEqual(45.9, TValue.From<Single>(45.9).Cast<Double>().AsType<Double>, 'TValue.From<Single>(45.9).Cast<Double>().AsType<Double>');
+  AreEqual(45.9, TValue.From<Single>(45.9).Cast<Extended>().AsType<Extended>, 'TValue.From<Single>(45.9).Cast<Extended>().AsType<Extended>');
+  AreEqual(-45689.46, TValue.From<Double>(-45689.46).Cast<Single>().AsType<Single>, 'TValue.From<Double>(-45689.46).Cast<Single>().AsType<Single>');
+  AreEqual(-45689.46, TValue.From<Double>(-45689.46).Cast<Extended>().AsType<Extended>, 'TValue.From<Double>(-45689.46).Cast<Extended>().AsType<Extended>');
+  AreEqual(662.546, TValue.From<Extended>(662.546).Cast<Single>().AsType<Single>, 'TValue.From<Extended>(662.546).Cast<Single>().AsType<Single>');
+  AreEqual(662.546, TValue.From<Extended>(662.546).Cast<Double>().AsType<Double>, 'TValue.From<Extended>(662.546).Cast<Double>().AsType<Double>');
+
+  if ErrorCount > 0 then
+    Halt(ErrorCount);
+end.