paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 15:47:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-11-13 23:22:49 +01:00
parent ccae78f97a
commit 2d0f8467fa
2 changed files with 107 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
packages/rtl-objpas/src/inc/rtti.pp
View File

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

50
tests/webtbs/tw41011.pp Normal file
View File

@ -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.