Browse Source

* fixed SimpleRoundTo() function (mantis #10159)

git-svn-id: trunk@12957 -
Jonas Maebe 16 years ago
parent
commit
1c2d2ae481
3 changed files with 60 additions and 6 deletions
  1. 1 0
      .gitattributes
  2. 15 6
      rtl/objpas/math.pp
  3. 44 0
      tests/webtbs/tw10159.pp

+ 1 - 0
.gitattributes

@@ -8613,6 +8613,7 @@ tests/webtbs/tw10013.pp svneol=native#text/plain
 tests/webtbs/tw10033.pp svneol=native#text/plain
 tests/webtbs/tw10033.pp svneol=native#text/plain
 tests/webtbs/tw10042.pp svneol=native#text/plain
 tests/webtbs/tw10042.pp svneol=native#text/plain
 tests/webtbs/tw10072.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/tw10203.pp svneol=native#text/plain
 tests/webtbs/tw1021.pp svneol=native#text/plain
 tests/webtbs/tw1021.pp svneol=native#text/plain
 tests/webtbs/tw10210.pp svneol=native#text/plain
 tests/webtbs/tw10210.pp svneol=native#text/plain

+ 15 - 6
rtl/objpas/math.pp

@@ -2353,8 +2353,11 @@ var
   RV : Single;
   RV : Single;
 
 
 begin
 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;
 end;
 {$endif}
 {$endif}
 
 
@@ -2365,8 +2368,11 @@ var
   RV : Double;
   RV : Double;
 
 
 begin
 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;
 end;
 {$endif}
 {$endif}
 
 
@@ -2377,8 +2383,11 @@ var
   RV : Extended;
   RV : Extended;
 
 
 begin
 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;
 end;
 {$endif}
 {$endif}
 
 

+ 44 - 0
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.
+