* 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

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

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 trunc(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
-    function round(c : comp) : int64;
+    function round(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}
-    function round_comp(c : comp) : int64;
+    function round_comp(c : comp) : int64; {$ifdef systeminline} inline; {$endif}
 {$endif not cpujvm}
 {$endif FPC_CURRENCY_IS_INT64}
 

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;
+        case softfloat_rounding_mode of
-        if absrem < 0 then
+          rmNearest:
-          absrem := -absrem;
+            begin
+              absrem := abs(rem);
               if (absrem > 0.5) or
                  ((absrem = 0.5) and
-            (rem > 0)) then
+                  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

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.