Browse Source

* properly round in ISO mode, resolves #35626

git-svn-id: trunk@43281 -
florian 5 years ago
parent
commit
d3c898a96b
3 changed files with 128 additions and 8 deletions
  1. 1 0
      .gitattributes
  2. 61 8
      rtl/inc/iso7185.pp
  3. 66 0
      tests/webtbs/tw35626.pp

+ 1 - 0
.gitattributes

@@ -17813,6 +17813,7 @@ tests/webtbs/tw3540.pp svneol=native#text/plain
 tests/webtbs/tw3546.pp svneol=native#text/plain
 tests/webtbs/tw35533.pp svneol=native#text/pascal
 tests/webtbs/tw3554.pp svneol=native#text/plain
+tests/webtbs/tw35626.pp -text svneol=native#text/pascal
 tests/webtbs/tw3564.pp svneol=native#text/plain
 tests/webtbs/tw3567.pp svneol=native#text/plain
 tests/webtbs/tw35670a.pp svneol=native#text/pascal

+ 61 - 8
rtl/inc/iso7185.pp

@@ -52,6 +52,18 @@ unit iso7185;
 
     Function Eof(var f:TypedFile): Boolean;
 
+{$ifdef FPC_CURRENCY_IS_INT64}
+{$ifndef FPUNONE}
+    function round(c : currency) : int64;
+{$endif FPUNONE}
+{$ifndef cpujvm}
+    function round(c : comp) : int64;
+{$else not cpujvm}
+    function round_comp(c : comp) : int64;
+{$endif not cpujvm}
+{$endif FPC_CURRENCY_IS_INT64}
+    function Round(d : ValReal) : int64;
+
   implementation
 
 
@@ -228,14 +240,55 @@ unit iso7185;
       End;
 
 
-   Function FilePos(var f:TypedFile):Int64;[IOCheck];
-     Begin
-       FilePos:=System.FilePos(f);
-       { in case of reading a file, the buffer is always filled, so the result of Do_FilePos is off by one }
-       if (FileRec(f).mode=fmInOut) or
-         (FileRec(f).mode=fmInput) then
-         dec(FilePos);
-     End;
+    Function FilePos(var f:TypedFile):Int64;[IOCheck];
+      Begin
+        FilePos:=System.FilePos(f);
+        { in case of reading a file, the buffer is always filled, so the result of Do_FilePos is off by one }
+        if (FileRec(f).mode=fmInOut) or
+          (FileRec(f).mode=fmInput) then
+          dec(FilePos);
+      End;
+
+
+{$ifdef FPC_CURRENCY_IS_INT64}
+{$ifndef FPUNONE}
+    function round(c : currency) : int64;
+      begin
+        if c>=0.0 then
+          Round:=Trunc(c+0.5)
+        else R
+          Round:=Trunc(c-0.5);
+      end;
+{$endif FPUNONE}
+
+
+{$ifndef cpujvm}
+    function round(c : comp) : int64;
+      begin
+        if c>=0.0 then
+          round:=Trunc(c+0.5)
+        else R
+          round:=Trunc(c-0.5);
+      end;
+{$else not cpujvm}
+    function round_comp(c : comp) : int64;
+      begin
+        if c>=0.0 then
+          round_comp:=Trunc(c+0.5)
+        else R
+          round_comp:=Trunc(c-0.5);
+      end;
+{$endif cpujvm}
+{$endif FPC_CURRENCY_IS_INT64}
+
+
+    function Round(d : ValReal) : int64;
+      begin
+        if d>=0.0 then
+          Round:=Trunc(d+0.5)
+        else
+          Round:=Trunc(d-0.5);
+      end;
 
 begin
   { we shouldn't do this because it might confuse user programs, but for now it

+ 66 - 0
tests/webtbs/tw35626.pp

@@ -0,0 +1,66 @@
+program RoundFunctionTest(output);
+
+{$MODE ISO}
+                                                                 {                      Expected result       }
+                                                                 { FPC result     in accordance with ISO 7185 }
+                                                                 { ----------     --------------------------- }
+begin
+  writeln('Testing the round() function with positive numbers:');
+  writeln('round(0.5)   = ', round(0.5));                        {     0                          1           }
+  if round(0.5)<>1 then
+    halt(1);
+  writeln('round(1.5)   = ', round(1.5));                        {     2                          2           }
+  if round(1.5)<>2 then
+    halt(1);
+  writeln('round(2.5)   = ', round(2.5));                        {     2                          3           }
+  if round(2.5)<>3 then
+    halt(1);
+  writeln('round(3.5)   = ', round(3.5));                        {     4                          4           }
+  if round(3.5)<>4 then
+    halt(1);
+  writeln('round(4.5)   = ', round(4.5));                        {     4                          5           }
+  if round(4.5)<>5 then
+    halt(1);
+  writeln('round(5.5)   = ', round(5.5));                        {     6                          6           }
+  if round(5.5)<>6 then
+    halt(1);
+  writeln('round(10.5)  = ', round(10.5));                       {    10                         11           }
+  if round(10.5)<>11 then
+    halt(1);
+  writeln('round(11.5)  = ', round(11.5));                       {    12                         12           }
+  if round(11.5)<>12 then
+    halt(1);
+  writeln('round(12.5)  = ', round(12.5));                       {    12                         13           }
+  if round(12.5)<>13 then
+    halt(1);
+  writeln;
+  writeln('Testing the round() function with negative numbers:');
+  writeln('round(-0.5)  = ', round(-0.5));                       {     0                         -1           }
+  if round(-0.5)<>-1 then
+    halt(1);
+  writeln('round(-1.5)  = ', round(-1.5));                       {    -2                         -2           }
+  if round(-1.5)<>-2 then
+    halt(1);
+  writeln('round(-2.5)  = ', round(-2.5));                       {    -2                         -3           }
+  if round(-2.5)<>-3 then
+    halt(1);
+  writeln('round(-3.5)  = ', round(-3.5));                       {    -4                         -4           }
+  if round(-3.5)<>-4 then
+    halt(1);
+  writeln('round(-4.5)  = ', round(-4.5));                       {    -4                         -5           }
+  if round(-4.5)<>-5 then
+    halt(1);
+  writeln('round(-5.5)  = ', round(-5.5));                       {    -6                         -6           }
+  if round(-5.5)<>-6 then
+    halt(1);
+  writeln('round(-10.5) = ', round(-10.5));                      {   -10                        -11           }
+  if round(-10.5)<>-11 then
+    halt(1);
+  writeln('round-(11.5) = ', round(-11.5));                      {   -12                        -12           }
+  if round(-11.5)<>-12 then
+    halt(1);
+  writeln('round(-12.5) = ', round(-12.5));                      {   -12                        -13           }
+  if round(-12.5)<>-13 then
+    halt(1);
+  writeln
+end.