From b359080f42f427da88a6dc8790f00f486ac2351e Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sun, 27 Dec 2020 13:19:02 +0000
Subject: [PATCH]   * fixed round(currency) so it takes the rounding mode into
 account on     platforms where currency is "type int64"   * inline
 trunc(currency), trunc(comp) and round(comp) on platforms where     currency
 and comp are "type int64"

git-svn-id: trunk@47859 -
---
 .gitattributes                    |  1 +
 rtl/inc/currh.inc                 | 10 ++--
 rtl/inc/gencurr.inc               | 48 ++++++++++++-------
 tests/test/units/math/trndcurr.pp | 78 +++++++++++++++++++++++++++++++
 4 files changed, 116 insertions(+), 21 deletions(-)
 create mode 100644 tests/test/units/math/trndcurr.pp

diff --git a/.gitattributes b/.gitattributes
index e6de8de503..64ab1de014 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -16112,6 +16112,7 @@ tests/test/units/math/tmask2.pp svneol=native#text/plain
 tests/test/units/math/tminmaxconst.pp svneol=native#text/pascal
 tests/test/units/math/tnaninf.pp svneol=native#text/plain
 tests/test/units/math/tpower.pp svneol=native#text/pascal
+tests/test/units/math/trndcurr.pp svneol=native#text/plain
 tests/test/units/math/troundm.pp svneol=native#text/plain
 tests/test/units/math/tsincos.pp svneol=native#text/pascal
 tests/test/units/math/ttrig1.pp svneol=native#text/plain
diff --git a/rtl/inc/currh.inc b/rtl/inc/currh.inc
index 82b1cacc77..18463a71a3 100644
--- a/rtl/inc/currh.inc
+++ b/rtl/inc/currh.inc
@@ -14,16 +14,16 @@
 
 
 {$ifdef FPC_CURRENCY_IS_INT64}
-    function trunc(c : currency) : int64;
+    function trunc(c : currency) : int64; {$ifdef systeminline} inline; {$endif}
 {$ifndef FPUNONE}
     function round(c : currency) : int64;
 {$endif FPUNONE}
 {$ifndef cpujvm}
-    function trunc(c : comp) : int64;
-    function round(c : comp) : int64;
+    function trunc(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
+    function round(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$else not cpujvm}
-    function trunc_comp(c: comp) : int64;
-    function round_comp(c : comp) : int64;
+    function trunc_comp(c: comp) : int64; {$ifdef systeminline} inline; {$endif}
+    function round_comp(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$endif not cpujvm}
 {$endif FPC_CURRENCY_IS_INT64}
 
diff --git a/rtl/inc/gencurr.inc b/rtl/inc/gencurr.inc
index 235be57312..6facfa5262 100644
--- a/rtl/inc/gencurr.inc
+++ b/rtl/inc/gencurr.inc
@@ -14,16 +14,16 @@
 
 {$ifdef FPC_CURRENCY_IS_INT64}
 
-    function trunc(c : currency) : int64;
+    function trunc(c : currency) : int64; {$ifdef systeminline} inline; {$endif}
       begin
         { the type conversion includes dividing by 10000 }
         result := int64(c)
       end;
 
 {$ifndef cpujvm}
-    function trunc(c : comp) : int64;
+    function trunc(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$else not cpujvm}
-    function trunc_comp(c : comp) : int64;
+    function trunc_comp(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$endif cpujvm}
       begin
         result := c
@@ -34,27 +34,43 @@
       var
         rem, absrem: currency;
       begin
-        { (int64(tmyrec(c))(+/-)5000) div 10000 can overflow }
         result := int64(c);
         rem := c - currency(result);
-        absrem := rem;
-        if absrem < 0 then
-          absrem := -absrem;
-        if (absrem > 0.5) or
-           ((absrem = 0.5) and
-            (rem > 0)) then
-          if (rem > 0) then
-            inc(result)
-          else
-            dec(result);
+        case softfloat_rounding_mode of
+          rmNearest:
+            begin
+              absrem := abs(rem);
+              if (absrem > 0.5) or
+                 ((absrem = 0.5) and
+                  odd(result)) then
+                if (rem > 0) then
+                  inc(result)
+                else
+                  dec(result)
+            end;
+          rmDown:
+            begin
+              if rem < 0 then
+                dec(result);
+            end;
+          rmUp:
+            begin
+              if rem > 0 then
+                inc(result);
+            end;
+          rmTruncate:
+            begin
+              // result is already ok
+            end;
+        end;
       end;
 {$endif FPUNONE}
 
 
 {$ifndef cpujvm}
-    function round(c : comp) : int64;
+    function round(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$else not cpujvm}
-    function round_comp(c : comp) : int64;
+    function round_comp(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$endif cpujvm}
       begin
         result := c
diff --git a/tests/test/units/math/trndcurr.pp b/tests/test/units/math/trndcurr.pp
new file mode 100644
index 0000000000..1c198789eb
--- /dev/null
+++ b/tests/test/units/math/trndcurr.pp
@@ -0,0 +1,78 @@
+uses
+  Math;
+
+{$ifndef SKIP_CURRENCY_TEST}
+procedure testround(const c, expected: currency; error: longint);
+begin
+  if round(c)<>expected then
+    begin
+      writeln('round(',c,') = ',round(c),' instead of ', expected);
+      halt(error);
+    end;
+end;
+
+{$endif}
+
+
+begin
+{$ifndef SKIP_CURRENCY_TEST}
+  writeln('Rounding mode: rmNearest (even)');
+  testround(0.5,0.0,1);
+  testround(1.5,2.0,2);
+  testround(-0.5,0.0,3);
+  testround(-1.5,-2.0,4);
+  testround(0.6,1.0,101);
+  testround(1.6,2.0,102);
+  testround(-0.6,-1.0,103);
+  testround(-1.6,-2.0,104);
+  testround(0.4,0.0,151);
+  testround(1.4,1.0,152);
+  testround(-0.4,-0.0,153);
+  testround(-1.4,-1.0,154);
+
+  writeln('Rounding mode: rmUp');
+  SetRoundMode(rmUp);
+  testround(0.5,1.0,5);
+  testround(1.5,2.0,6);
+  testround(-0.5,0.0,7);
+  testround(-1.5,-1.0,8);
+  testround(0.6,1.0,105);
+  testround(1.6,2.0,106);
+  testround(-0.6,0.0,107);
+  testround(-1.6,-1.0,108);
+  testround(0.4,1.0,155);
+  testround(1.4,2.0,156);
+  testround(-0.4,0.0,157);
+  testround(-1.4,-1.0,158);
+
+  writeln('Rounding mode: rmDown');
+  SetRoundMode(rmDown);
+  testround(0.5,0.0,9);
+  testround(1.5,1.0,10);
+  testround(-0.5,-1.0,11);
+  testround(-1.5,-2.0,12);
+  testround(0.6,0.0,109);
+  testround(1.6,1.0,110);
+  testround(-0.6,-1.0,111);
+  testround(-1.6,-2.0,112);
+  testround(0.4,0.0,159);
+  testround(1.4,1.0,160);
+  testround(-0.4,-1.0,161);
+  testround(-1.4,-2.0,162);
+
+  writeln('Rounding mode: rmTruncate');
+  SetRoundMode(rmTruncate);
+  testround(0.5,0.0,13);
+  testround(1.5,1.0,14);
+  testround(-0.5,0.0,15);
+  testround(-1.5,-1.0,16);
+  testround(0.6,0.0,113);
+  testround(1.6,1.0,114);
+  testround(-0.6,0.0,115);
+  testround(-1.6,-1.0,116);
+  testround(0.4,0.0,163);
+  testround(1.4,1.0,164);
+  testround(-0.4,0.0,165);
+  testround(-1.4,-1.0,166);
+{$endif}
+end.