paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 03:19:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed SimpleRoundTo() function (mantis #10159)

Browse Source 
git-svn-id: trunk@12957 -
This commit is contained in:
Jonas Maebe 2009-03-22 16:29:54 +00:00
parent 624a7be9b1
commit 1c2d2ae481
3 changed files with 60 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

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

21
rtl/objpas/math.pp
View File

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

44
tests/webtbs/tw10159.pp Normal file
View File

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