diff --git a/.gitattributes b/.gitattributes index 5d8793468e..efbc97b0c6 100644 --- a/.gitattributes +++ b/.gitattributes @@ -8613,6 +8613,7 @@ tests/webtbs/tw10013.pp svneol=native#text/plain tests/webtbs/tw10033.pp svneol=native#text/plain tests/webtbs/tw10042.pp svneol=native#text/plain tests/webtbs/tw10072.pp svneol=native#text/plain +tests/webtbs/tw10159.pp svneol=native#text/plain tests/webtbs/tw10203.pp svneol=native#text/plain tests/webtbs/tw1021.pp svneol=native#text/plain tests/webtbs/tw10210.pp svneol=native#text/plain diff --git a/rtl/objpas/math.pp b/rtl/objpas/math.pp index 8fe57e75c9..b35924d2d6 100644 --- a/rtl/objpas/math.pp +++ b/rtl/objpas/math.pp @@ -2353,8 +2353,11 @@ var RV : Single; begin - RV:=IntPower(10,Digits); - Result:=Trunc((AValue/RV)+0.5)*RV; + RV := IntPower(10, -Digits); + if AValue < 0 then + Result := Trunc((AValue*RV) - 0.5)/RV + else + Result := Trunc((AValue*RV) + 0.5)/RV; end; {$endif} @@ -2365,8 +2368,11 @@ var RV : Double; begin - RV:=IntPower(10,Digits); - Result:=Trunc((AValue/RV)+0.5)*RV; + RV := IntPower(10, -Digits); + if AValue < 0 then + Result := Trunc((AValue*RV) - 0.5)/RV + else + Result := Trunc((AValue*RV) + 0.5)/RV; end; {$endif} @@ -2377,8 +2383,11 @@ var RV : Extended; begin - RV:=IntPower(10,Digits); - Result:=Trunc((AValue/RV)+0.5)*RV; + RV := IntPower(10, -Digits); + if AValue < 0 then + Result := Trunc((AValue*RV) - 0.5)/RV + else + Result := Trunc((AValue*RV) + 0.5)/RV; end; {$endif} diff --git a/tests/webtbs/tw10159.pp b/tests/webtbs/tw10159.pp new file mode 100644 index 0000000000..34a31a0144 --- /dev/null +++ b/tests/webtbs/tw10159.pp @@ -0,0 +1,44 @@ +{$ifdef fpc} +{$mode delphi} +{$endif} + +uses + Math; + +var + J, K, L: integer; + X, Y: extended; + errors: integer; + +begin + errors:=0; + for J := 0 to 9 do + for K := 0 to 9 do + for L := 0 to 9 do + begin + X := ( J / 10 + K / 100 ); + Y := X + L / 1000; + + if L >= 5 then + X := X + 1 / 100; + + if abs( SimpleRoundTo( Y, -2 ) - X ) > 0.005 then + begin + writeln( '0.', J, K, L, ' ', Y, SimpleRoundTo( Y, -2 ), Y:5:2 ); + inc(errors); + end; + if abs( SimpleRoundTo( -Y, -2 ) - (-X) ) > 0.005 then + begin + writeln( '0.', J, K, L, ' ', -Y, ' ', SimpleRoundTo( -Y, -2 ), ' ', (-Y):5:2 ); + inc(errors); + end; + if (abs(SimpleRoundTo( -Y, -2 ))<>abs(SimpleRoundTo( Y, -2 ))) then + halt(1); + end; + { don't do anything with the errors yet, because there are many in any + case. For proper fixing, it needs to use some method like in + John Herbster's DecimalRounding unit + } + writeln('errors: ',errors); +end. // Test. +