diff --git a/packages/rtl-objpas/src/inc/rtti.pp b/packages/rtl-objpas/src/inc/rtti.pp index 3693eb419f..c3c434fedb 100644 --- a/packages/rtl-objpas/src/inc/rtti.pp +++ b/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. \ No newline at end of file +end. diff --git a/tests/webtbs/tw41011.pp b/tests/webtbs/tw41011.pp new file mode 100644 index 0000000000..2a90541a04 --- /dev/null +++ b/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(-10).Cast().AsType, 'TValue.From(-10).Cast().AsType'); + AreEqual(205, TValue.From(205).Cast().AsType, 'TValue.From(205).Cast().AsType'); + AreEqual(-30012, TValue.From(-30012).Cast().AsType, 'TValue.From(-30012).Cast().AsType'); + AreEqual(60123, TValue.From(60123).Cast().AsType, 'TValue.From(60123).Cast().AsType'); + AreEqual(-12, TValue.From(-12).Cast().AsType, 'TValue.From(-12).Cast().AsType'); + AreEqual(42, TValue.From(42).Cast().AsType, 'TValue.From(42).Cast().AsType'); + + AreEqual(-10, TValue.From(-10).Cast().AsType, 'TValue.From(-10).Cast().AsType'); + AreEqual(205, TValue.From(205).Cast().AsType, 'TValue.From(205).Cast().AsType'); + AreEqual(-30012, TValue.From(-30012).Cast().AsType, 'TValue.From(-30012).Cast().AsType'); + AreEqual(60123, TValue.From(60123).Cast().AsType, 'TValue.From(60123).Cast().AsType'); + AreEqual(-12, TValue.From(-12).Cast().AsType, 'TValue.From(-12).Cast().AsType'); + AreEqual(42, TValue.From(42).Cast().AsType, 'TValue.From(42).Cast().AsType'); + + AreEqual(-10, TValue.From(-10).Cast().AsType, 'TValue.From(-10).Cast().AsType'); + AreEqual(205, TValue.From(205).Cast().AsType, 'TValue.From(205).Cast().AsType'); + AreEqual(-30012, TValue.From(-30012).Cast().AsType, 'TValue.From(-30012).Cast().AsType'); + AreEqual(60123, TValue.From(60123).Cast().AsType, 'TValue.From(60123).Cast().AsType'); + AreEqual(-12, TValue.From(-12).Cast().AsType, 'TValue.From(-12).Cast().AsType'); + AreEqual(42, TValue.From(42).Cast().AsType, 'TValue.From(42).Cast().AsType'); + + AreEqual(45.9, TValue.From(45.9).Cast().AsType, 'TValue.From(45.9).Cast().AsType'); + AreEqual(45.9, TValue.From(45.9).Cast().AsType, 'TValue.From(45.9).Cast().AsType'); + AreEqual(-45689.46, TValue.From(-45689.46).Cast().AsType, 'TValue.From(-45689.46).Cast().AsType'); + AreEqual(-45689.46, TValue.From(-45689.46).Cast().AsType, 'TValue.From(-45689.46).Cast().AsType'); + AreEqual(662.546, TValue.From(662.546).Cast().AsType, 'TValue.From(662.546).Cast().AsType'); + AreEqual(662.546, TValue.From(662.546).Cast().AsType, 'TValue.From(662.546).Cast().AsType'); + + if ErrorCount > 0 then + Halt(ErrorCount); +end. \ No newline at end of file