+ support for the different rounding modes in the generic rounding

    routines (mantis #11392)

git-svn-id: trunk@11290 -

.gitattributes

@@ -8352,6 +8352,7 @@ tests/webtbs/tw1133.pp svneol=native#text/plain
 tests/webtbs/tw11349.pp svneol=native#text/plain
 tests/webtbs/tw11354.pp svneol=native#text/plain
 tests/webtbs/tw11372.pp svneol=native#text/plain
+tests/webtbs/tw11392.pp svneol=native#text/plain
 tests/webtbs/tw1152.pp svneol=native#text/plain
 tests/webtbs/tw11543.pp svneol=native#text/plain
 tests/webtbs/tw1157.pp svneol=native#text/plain

rtl/arm/mathu.inc

@@ -91,6 +91,16 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 var
   c: dword;
 begin
+  case (RoundMode) of
+    rmNearest :
+      softfloat_rounding_mode := float_round_nearest_even;
+    rmTruncate :
+      softfloat_rounding_mode := float_round_to_zero;
+    rmUp :
+      softfloat_rounding_mode := float_round_up;
+    rmDown :
+      softfloat_rounding_mode := float_round_down;
+  end;
   c:=Ord(RoundMode) shl 16;
   c:=_controlfp(c, _MCW_RC);
   Result:=TFPURoundingMode((c shr 16) and 3);

rtl/inc/cgenmath.inc

@@ -107,11 +107,32 @@
 
     function c_llround(d: double): int64; cdecl; external 'c' name 'llround';
 
-//    function round(d : Real) : int64; external name 'FPC_ROUND';
-
     function fpc_round_real(d : ValReal) : int64;[public, alias:'FPC_ROUND'];compilerproc;
     begin
-      fpc_round_real := c_llround(d);
+      case softfloat_rounding_mode of
+        float_round_nearest_even:
+          begin
+            fpc_round_real:=c_llround(d);
+            { llround always rounds half-way cases away from zero, }
+            { regardless of the current rounding mode              }
+            if (abs(frac(d))=0.5) then
+              fpc_round_real:=2*trunc(fpc_round_real*extended(0.5));
+          end;
+        float_round_down:
+          if (d>=0) or
+             (frac(d)=0.0) then
+            result:=trunc(d)
+          else
+            result:=trunc(d-1.0);
+        float_round_up:
+          if (d>=0) and
+             (frac(d)<>0.0) then
+            result:=trunc(d+1.0)
+          else
+            result:=trunc(d);
+        float_round_to_zero:
+          result:=trunc(d);
+      end;
     end;
 {$endif not FPC_SYSTEM_HAS_ROUND}
 

rtl/inc/genmath.inc

@@ -944,23 +944,45 @@ invalid:
       fr: Real;
       tr: Int64;
     Begin
-       fr := abs(Frac(d));
-       tr := Trunc(d);
-       if fr > 0.5 then
-         if d >= 0 then
-           result:=tr+1
-         else
-           result:=tr-1
-       else
-       if fr < 0.5 then
-          result:=tr
-       else { fr = 0.5 }
-          { check sign to decide ... }
-          { as in Turbo Pascal...    }
-          if d >= 0.0 then
-            result:=tr+1
+      case softfloat_rounding_mode of
+        float_round_nearest_even:
+          begin
+            fr := abs(Frac(d));
+            tr := Trunc(d);
+            if fr > 0.5 then
+              if d >= 0 then
+                result:=tr+1
+              else
+                result:=tr-1
+            else
+            if fr < 0.5 then
+               result:=tr
+            else { fr = 0.5 }
+               { check sign to decide ... }
+               { as in Turbo Pascal...    }
+              begin
+                if d >= 0.0 then
+                  result:=tr+1
+                else
+                  result:=tr-1;
+                result:=2*trunc(result*0.5);
+              end;
+          end;
+        float_round_down:
+          if (d>=0) or
+             (frac(d)=0.0) then
+            result:=trunc(d)
           else
-            result:=tr;
+            result:=trunc(d-1.0);
+        float_round_up:
+          if (d>=0) and
+             (frac(d)<>0.0) then
+            result:=trunc(d+1.0)
+          else
+            result:=trunc(d);
+        float_round_to_zero:
+          result:=trunc(d);
+      end;
     end;
 {$endif FPC_SYSTEM_HAS_ROUND}
 

rtl/powerpc/mathu.inc

@@ -56,10 +56,26 @@ var
   mode : DWord;
 begin
   case (RoundMode) of
-    rmNearest : mode := 0;
-    rmTruncate : mode := 1;
-    rmUp : mode := 2;
-    rmDown : mode := 3;
+    rmNearest :
+      begin
+        mode := 0;
+        softfloat_rounding_mode := float_round_nearest_even;
+      end;
+    rmTruncate :
+      begin
+        mode := 1;
+        softfloat_rounding_mode := float_round_to_zero;
+      end;
+    rmUp :
+      begin
+        mode := 2;
+        softfloat_rounding_mode := float_round_up;
+      end;
+    rmDown :
+      begin
+        mode := 3;
+        softfloat_rounding_mode := float_round_down;
+      end;
   end;
   setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
   result := RoundMode;

rtl/powerpc64/mathu.inc

@@ -56,10 +56,36 @@ var
   mode : DWord;
 begin
   case (RoundMode) of
-    rmNearest : mode := 0;
-    rmTruncate : mode := 1;
-    rmUp : mode := 2;
-    rmDown : mode := 3;
+    rmNearest :
+      begin
+        mode := 0;
+{ 2.3.x has internal rounding support, which does the right thing }
+{ automatically                                                   }
+{$ifdef VER2_2}
+        softfloat_rounding_mode := float_round_nearest_even;
+{$endif}
+      end;
+    rmTruncate :
+      begin
+        mode := 1;
+{$ifdef VER2_2}
+        softfloat_rounding_mode := float_round_to_zero;
+{$endif}
+      end;
+    rmUp :
+      begin
+        mode := 2;
+{$ifdef VER2_2}
+        softfloat_rounding_mode := float_round_up;
+{$endif}
+      end;
+    rmDown :
+      begin
+        mode := 3;
+{$ifdef VER2_2}
+        softfloat_rounding_mode := float_round_down;
+{$endif}
+      end;
   end;
   setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
   result := RoundMode;

rtl/sparc/mathu.inc

@@ -40,6 +40,16 @@ function GetRoundMode: TFPURoundingMode;
 
 function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
   begin
+    case (RoundMode) of
+      rmNearest :
+        softfloat_rounding_mode := float_round_nearest_even;
+      rmTruncate :
+        softfloat_rounding_mode := float_round_to_zero;
+      rmUp :
+        softfloat_rounding_mode := float_round_up;
+      rmDown :
+        softfloat_rounding_mode := float_round_down;
+    end;
     set_fsr((get_fsr and $3fffffff) or (dword(RoundMode) shl 30));
     result:=TFPURoundingMode(get_fsr shr 30);
   end;

tests/webtbs/tw11392.pp

@@ -0,0 +1,686 @@
+uses
+  Math;
+
+const
+  p00 = 0.0;
+  p04 = 0.4;
+  p05 = 0.5;
+  p06 = 0.6;
+  p10 = 1.0;
+  p14 = 1.4;
+  p15 = 1.5;
+  p16 = 1.6;
+  p20 = 2.0;
+  p24 = 2.4;
+  p25 = 2.5;
+  p26 = 2.6;
+  p80 = 9999999999998.0;
+  p84 = 9999999999998.4;
+  p85 = 9999999999998.5;
+  p86 = 9999999999998.6;
+  p90 = 9999999999999.0;
+  p94 = 9999999999999.4;
+  p95 = 9999999999999.5;
+  p96 = 9999999999999.6;
+  n00 = -0.0;
+  n04 = -0.4;
+  n05 = -0.5;
+  n06 = -0.6;
+  n10 = -1.0;
+  n14 = -1.4;
+  n15 = -1.5;
+  n16 = -1.6;
+  n20 = -2.0;
+  n24 = -2.4;
+  n25 = -2.5;
+  n26 = -2.6;
+  n80 = -9999999999998.0;
+  n84 = -9999999999998.4;
+  n85 = -9999999999998.5;
+  n86 = -9999999999998.6;
+  n90 = -9999999999999.0;
+  n94 = -9999999999999.4;
+  n95 = -9999999999999.5;
+  n96 = -9999999999999.6;
+
+  rp00 = round(0.0);
+  rp04 = round(0.4);
+  rp05 = round(0.5);
+  rp06 = round(0.6);
+  rp10 = round(1.0);
+  rp14 = round(1.4);
+  rp15 = round(1.5);
+  rp16 = round(1.6);
+  rp20 = round(2.0);
+  rp24 = round(2.4);
+  rp25 = round(2.5);
+  rp26 = round(2.6);
+  rp80 = round(9999999999998.0);
+  rp84 = round(9999999999998.4);
+  rp85 = round(9999999999998.5);
+  rp86 = round(9999999999998.6);
+  rp90 = round(9999999999999.0);
+  rp94 = round(9999999999999.4);
+  rp95 = round(9999999999999.5);
+  rp96 = round(9999999999999.6);
+  rn00 = round(-0.0);
+  rn04 = round(-0.4);
+  rn05 = round(-0.5);
+  rn06 = round(-0.6);
+  rn10 = round(-1.0);
+  rn14 = round(-1.4);
+  rn15 = round(-1.5);
+  rn16 = round(-1.6);
+  rn20 = round(-2.0);
+  rn24 = round(-2.4);
+  rn25 = round(-2.5);
+  rn26 = round(-2.6);
+  rn80 = round(-9999999999998.0);
+  rn84 = round(-9999999999998.4);
+  rn85 = round(-9999999999998.5);
+  rn86 = round(-9999999999998.6);
+  rn90 = round(-9999999999999.0);
+  rn94 = round(-9999999999999.4);
+  rn95 = round(-9999999999999.5);
+  rn96 = round(-9999999999999.6);
+
+procedure check(e: extended; res,want: int64);
+begin
+  if (res<>want) then
+    begin
+      writeln(' *** Error for round(',e:0,'): got ',res,' expected ',want);
+      halt(1);
+    end;
+end;
+
+
+procedure testconstrndnearest;
+begin
+  check(p00,rp00,0);
+  check(p04,rp04,0);
+  check(p05,rp05,0);
+  check(p06,rp06,1);
+  check(p10,rp10,1);
+  check(p14,rp14,1);
+  check(p15,rp15,2);
+  check(p16,rp16,2);
+  check(p20,rp20,2);
+  check(p24,rp24,2);
+  check(p25,rp25,2);
+  check(p26,rp26,3);
+  check(p80,rp80,9999999999998);
+  check(p84,rp84,9999999999998);
+  check(p85,rp85,9999999999998);
+  check(p86,rp86,9999999999999);
+  check(p90,rp90,9999999999999);
+  check(p94,rp94,9999999999999);
+  check(p95,rp95,10000000000000);
+  check(p96,rp96,10000000000000);
+  check(n00,rn00,0);
+  check(n04,rn04,0);
+  check(n05,rn05,0);
+  check(n06,rn06,-1);
+  check(n10,rn10,-1);
+  check(n14,rn14,-1);
+  check(n15,rn15,-2);
+  check(n16,rn16,-2);
+  check(n20,rn20,-2);
+  check(n24,rn24,-2);
+  check(n25,rn25,-2);
+  check(n26,rn26,-3);
+  check(n80,rn80,-9999999999998);
+  check(n84,rn84,-9999999999998);
+  check(n85,rn85,-9999999999998);
+  check(n86,rn86,-9999999999999);
+  check(n90,rn90,-9999999999999);
+  check(n94,rn94,-9999999999999);
+  check(n95,rn95,-10000000000000);
+  check(n96,rn96,-10000000000000);
+
+  check(p00,round(p00),0);
+  check(p04,round(p04),0);
+  check(p05,round(p05),0);
+  check(p06,round(p06),1);
+  check(p10,round(p10),1);
+  check(p14,round(p14),1);
+  check(p15,round(p15),2);
+  check(p16,round(p16),2);
+  check(p20,round(p20),2);
+  check(p24,round(p24),2);
+  check(p25,round(p25),2);
+  check(p26,round(p26),3);
+  check(p80,round(p80),9999999999998);
+  check(p84,round(p84),9999999999998);
+  check(p85,round(p85),9999999999998);
+  check(p86,round(p86),9999999999999);
+  check(p90,round(p90),9999999999999);
+  check(p94,round(p94),9999999999999);
+  check(p95,round(p95),10000000000000);
+  check(p96,round(p96),10000000000000);
+  check(n00,round(n00),0);
+  check(n04,round(n04),0);
+  check(n05,round(n05),0);
+  check(n06,round(n06),-1);
+  check(n10,round(n10),-1);
+  check(n14,round(n14),-1);
+  check(n15,round(n15),-2);
+  check(n16,round(n16),-2);
+  check(n20,round(n20),-2);
+  check(n24,round(n24),-2);
+  check(n25,round(n25),-2);
+  check(n26,round(n26),-3);
+  check(n80,round(n80),-9999999999998);
+  check(n84,round(n84),-9999999999998);
+  check(n85,round(n85),-9999999999998);
+  check(n86,round(n86),-9999999999999);
+  check(n90,round(n90),-9999999999999);
+  check(n94,round(n94),-9999999999999);
+  check(n95,round(n95),-10000000000000);
+  check(n96,round(n96),-10000000000000);
+end;
+
+procedure testvarrndnearest;
+var
+  e: extended;
+begin
+  e:=p00;
+  check(e,round(e),0);
+  e:=p04;
+  check(e,round(e),0);
+  e:=p05;
+  check(e,round(e),0);
+  e:=p06;
+  check(e,round(e),1);
+  e:=p10;
+  check(e,round(e),1);
+  e:=p14;
+  check(e,round(e),1);
+  e:=p15;
+  check(e,round(e),2);
+  e:=p16;
+  check(e,round(e),2);
+  e:=p20;
+  check(e,round(e),2);
+  e:=p24;
+  check(e,round(e),2);
+  e:=p25;
+  check(e,round(e),2);
+  e:=p26;
+  check(e,round(e),3);
+  e:=p80;
+  check(e,round(e),9999999999998);
+  e:=p84;
+  check(e,round(e),9999999999998);
+  e:=p85;
+  check(e,round(e),9999999999998);
+  e:=p86;
+  check(e,round(e),9999999999999);
+  e:=p90;
+  check(e,round(e),9999999999999);
+  e:=p94;
+  check(e,round(e),9999999999999);
+  e:=p95;
+  check(e,round(e),10000000000000);
+  e:=p96;
+  check(e,round(e),10000000000000);
+  e:=n00;
+  check(e,round(e),0);
+  e:=n04;
+  check(e,round(e),0);
+  e:=n05;
+  check(e,round(e),0);
+  e:=n06;
+  check(e,round(e),-1);
+  e:=n10;
+  check(e,round(e),-1);
+  e:=n14;
+  check(e,round(e),-1);
+  e:=n15;
+  check(e,round(e),-2);
+  e:=n16;
+  check(e,round(e),-2);
+  e:=n20;
+  check(e,round(e),-2);
+  e:=n24;
+  check(e,round(e),-2);
+  e:=n25;
+  check(e,round(e),-2);
+  e:=n26;
+  check(e,round(e),-3);
+  e:=n80;
+  check(e,round(e),-9999999999998);
+  e:=n84;
+  check(e,round(e),-9999999999998);
+  e:=n85;
+  check(e,round(e),-9999999999998);
+  e:=n86;
+  check(e,round(e),-9999999999999);
+  e:=n90;
+  check(e,round(e),-9999999999999);
+  e:=n94;
+  check(e,round(e),-9999999999999);
+  e:=n95;
+  check(e,round(e),-10000000000000);
+  e:=n96;
+  check(e,round(e),-10000000000000);
+end;
+
+
+procedure testconstrnddown;
+begin
+  check(p00,round(p00),0);
+  check(p04,round(p04),0);
+  check(p05,round(p05),0);
+  check(p06,round(p06),0);
+  check(p10,round(p10),1);
+  check(p14,round(p14),1);
+  check(p15,round(p15),1);
+  check(p16,round(p16),1);
+  check(p20,round(p20),2);
+  check(p24,round(p24),2);
+  check(p25,round(p25),2);
+  check(p26,round(p26),2);
+  check(p80,round(p80),9999999999998);
+  check(p84,round(p84),9999999999998);
+  check(p85,round(p85),9999999999998);
+  check(p86,round(p86),9999999999998);
+  check(p90,round(p90),9999999999999);
+  check(p94,round(p94),9999999999999);
+  check(p95,round(p95),9999999999999);
+  check(p96,round(p96),9999999999999);
+  check(n00,round(n00),0);
+  check(n04,round(n04),-1);
+  check(n05,round(n05),-1);
+  check(n06,round(n06),-1);
+  check(n10,round(n10),-1);
+  check(n14,round(n14),-2);
+  check(n15,round(n15),-2);
+  check(n16,round(n16),-2);
+  check(n20,round(n20),-2);
+  check(n24,round(n24),-3);
+  check(n25,round(n25),-3);
+  check(n26,round(n26),-3);
+  check(n80,round(n80),-9999999999998);
+  check(n84,round(n84),-9999999999999);
+  check(n85,round(n85),-9999999999999);
+  check(n86,round(n86),-9999999999999);
+  check(n90,round(n90),-9999999999999);
+  check(n94,round(n94),-10000000000000);
+  check(n95,round(n95),-10000000000000);
+  check(n96,round(n96),-10000000000000);
+end;
+
+procedure testvarrnddown;
+var
+  e: extended;
+begin
+  e:=p00;
+  check(e,round(e),0);
+  e:=p04;
+  check(e,round(e),0);
+  e:=p05;
+  check(e,round(e),0);
+  e:=p06;
+  check(e,round(e),0);
+  e:=p10;
+  check(e,round(e),1);
+  e:=p14;
+  check(e,round(e),1);
+  e:=p15;
+  check(e,round(e),1);
+  e:=p16;
+  check(e,round(e),1);
+  e:=p20;
+  check(e,round(e),2);
+  e:=p24;
+  check(e,round(e),2);
+  e:=p25;
+  check(e,round(e),2);
+  e:=p26;
+  check(e,round(e),2);
+  e:=p80;
+  check(e,round(e),9999999999998);
+  e:=p84;
+  check(e,round(e),9999999999998);
+  e:=p85;
+  check(e,round(e),9999999999998);
+  e:=p86;
+  check(e,round(e),9999999999998);
+  e:=p90;
+  check(e,round(e),9999999999999);
+  e:=p94;
+  check(e,round(e),9999999999999);
+  e:=p95;
+  check(e,round(e),9999999999999);
+  e:=p96;
+  check(e,round(e),9999999999999);
+  e:=n00;
+  check(e,round(e),0);
+  e:=n04;
+  check(e,round(e),-1);
+  e:=n05;
+  check(e,round(e),-1);
+  e:=n06;
+  check(e,round(e),-1);
+  e:=n10;
+  check(e,round(e),-1);
+  e:=n14;
+  check(e,round(e),-2);
+  e:=n15;
+  check(e,round(e),-2);
+  e:=n16;
+  check(e,round(e),-2);
+  e:=n20;
+  check(e,round(e),-2);
+  e:=n24;
+  check(e,round(e),-3);
+  e:=n25;
+  check(e,round(e),-3);
+  e:=n26;
+  check(e,round(e),-3);
+  e:=n80;
+  check(e,round(e),-9999999999998);
+  e:=n84;
+  check(e,round(e),-9999999999999);
+  e:=n85;
+  check(e,round(e),-9999999999999);
+  e:=n86;
+  check(e,round(e),-9999999999999);
+  e:=n90;
+  check(e,round(e),-9999999999999);
+  e:=n94;
+  check(e,round(e),-10000000000000);
+  e:=n95;
+  check(e,round(e),-10000000000000);
+  e:=n96;
+  check(e,round(e),-10000000000000);
+end;
+
+
+procedure testconstrndup;
+begin
+  check(p00,round(p00),0);
+  check(p04,round(p04),1);
+  check(p05,round(p05),1);
+  check(p06,round(p06),1);
+  check(p10,round(p10),1);
+  check(p14,round(p14),2);
+  check(p15,round(p15),2);
+  check(p16,round(p16),2);
+  check(p20,round(p20),2);
+  check(p24,round(p24),3);
+  check(p25,round(p25),3);
+  check(p26,round(p26),3);
+  check(p80,round(p80),9999999999998);
+  check(p84,round(p84),9999999999999);
+  check(p85,round(p85),9999999999999);
+  check(p86,round(p86),9999999999999);
+  check(p90,round(p90),9999999999999);
+  check(p94,round(p94),10000000000000);
+  check(p95,round(p95),10000000000000);
+  check(p96,round(p96),10000000000000);
+  check(n00,round(n00),0);
+  check(n04,round(n04),0);
+  check(n05,round(n05),0);
+  check(n06,round(n06),0);
+  check(n10,round(n10),-1);
+  check(n14,round(n14),-1);
+  check(n15,round(n15),-1);
+  check(n16,round(n16),-1);
+  check(n20,round(n20),-2);
+  check(n24,round(n24),-2);
+  check(n25,round(n25),-2);
+  check(n26,round(n26),-2);
+  check(n80,round(n80),-9999999999998);
+  check(n84,round(n84),-9999999999998);
+  check(n85,round(n85),-9999999999998);
+  check(n86,round(n86),-9999999999998);
+  check(n90,round(n90),-9999999999999);
+  check(n94,round(n94),-9999999999999);
+  check(n95,round(n95),-9999999999999);
+  check(n96,round(n96),-9999999999999);
+end;
+
+procedure testvarrndup;
+var
+  e: extended;
+begin
+  e:=p00;
+  check(e,round(e),0);
+  e:=p04;
+  check(e,round(e),1);
+  e:=p05;
+  check(e,round(e),1);
+  e:=p06;
+  check(e,round(e),1);
+  e:=p10;
+  check(e,round(e),1);
+  e:=p14;
+  check(e,round(e),2);
+  e:=p15;
+  check(e,round(e),2);
+  e:=p16;
+  check(e,round(e),2);
+  e:=p20;
+  check(e,round(e),2);
+  e:=p24;
+  check(e,round(e),3);
+  e:=p25;
+  check(e,round(e),3);
+  e:=p26;
+  check(e,round(e),3);
+  e:=p80;
+  check(e,round(e),9999999999998);
+  e:=p84;
+  check(e,round(e),9999999999999);
+  e:=p85;
+  check(e,round(e),9999999999999);
+  e:=p86;
+  check(e,round(e),9999999999999);
+  e:=p90;
+  check(e,round(e),9999999999999);
+  e:=p94;
+  check(e,round(e),10000000000000);
+  e:=p95;
+  check(e,round(e),10000000000000);
+  e:=p96;
+  check(e,round(e),10000000000000);
+  e:=n00;
+  check(e,round(e),0);
+  e:=n04;
+  check(e,round(e),0);
+  e:=n05;
+  check(e,round(e),0);
+  e:=n06;
+  check(e,round(e),0);
+  e:=n10;
+  check(e,round(e),-1);
+  e:=n14;
+  check(e,round(e),-1);
+  e:=n15;
+  check(e,round(e),-1);
+  e:=n16;
+  check(e,round(e),-1);
+  e:=n20;
+  check(e,round(e),-2);
+  e:=n24;
+  check(e,round(e),-2);
+  e:=n25;
+  check(e,round(e),-2);
+  e:=n26;
+  check(e,round(e),-2);
+  e:=n80;
+  check(e,round(e),-9999999999998);
+  e:=n84;
+  check(e,round(e),-9999999999998);
+  e:=n85;
+  check(e,round(e),-9999999999998);
+  e:=n86;
+  check(e,round(e),-9999999999998);
+  e:=n90;
+  check(e,round(e),-9999999999999);
+  e:=n94;
+  check(e,round(e),-9999999999999);
+  e:=n95;
+  check(e,round(e),-9999999999999);
+  e:=n96;
+  check(e,round(e),-9999999999999);
+end;
+
+
+procedure testconstrndtrunc;
+begin
+  check(p00,round(p00),0);
+  check(p04,round(p04),0);
+  check(p05,round(p05),0);
+  check(p06,round(p06),0);
+  check(p10,round(p10),1);
+  check(p14,round(p14),1);
+  check(p15,round(p15),1);
+  check(p16,round(p16),1);
+  check(p20,round(p20),2);
+  check(p24,round(p24),2);
+  check(p25,round(p25),2);
+  check(p26,round(p26),2);
+  check(p80,round(p80),9999999999998);
+  check(p84,round(p84),9999999999998);
+  check(p85,round(p85),9999999999998);
+  check(p86,round(p86),9999999999998);
+  check(p90,round(p90),9999999999999);
+  check(p94,round(p94),9999999999999);
+  check(p95,round(p95),9999999999999);
+  check(p96,round(p96),9999999999999);
+  check(n00,round(n00),0);
+  check(n04,round(n04),0);
+  check(n05,round(n05),0);
+  check(n06,round(n06),0);
+  check(n10,round(n10),-1);
+  check(n14,round(n14),-1);
+  check(n15,round(n15),-1);
+  check(n16,round(n16),-1);
+  check(n20,round(n20),-2);
+  check(n24,round(n24),-2);
+  check(n25,round(n25),-2);
+  check(n26,round(n26),-2);
+  check(n80,round(n80),-9999999999998);
+  check(n84,round(n84),-9999999999998);
+  check(n85,round(n85),-9999999999998);
+  check(n86,round(n86),-9999999999998);
+  check(n90,round(n90),-9999999999999);
+  check(n94,round(n94),-9999999999999);
+  check(n95,round(n95),-9999999999999);
+  check(n96,round(n96),-9999999999999);
+end;
+
+procedure testvarrndtrunc;
+var
+  e: extended;
+begin
+  e:=p00;
+  check(e,round(e),0);
+  e:=p04;
+  check(e,round(e),0);
+  e:=p05;
+  check(e,round(e),0);
+  e:=p06;
+  check(e,round(e),0);
+  e:=p10;
+  check(e,round(e),1);
+  e:=p14;
+  check(e,round(e),1);
+  e:=p15;
+  check(e,round(e),1);
+  e:=p16;
+  check(e,round(e),1);
+  e:=p20;
+  check(e,round(e),2);
+  e:=p24;
+  check(e,round(e),2);
+  e:=p25;
+  check(e,round(e),2);
+  e:=p26;
+  check(e,round(e),2);
+  e:=p80;
+  check(e,round(e),9999999999998);
+  e:=p84;
+  check(e,round(e),9999999999998);
+  e:=p85;
+  check(e,round(e),9999999999998);
+  e:=p86;
+  check(e,round(e),9999999999998);
+  e:=p90;
+  check(e,round(e),9999999999999);
+  e:=p94;
+  check(e,round(e),9999999999999);
+  e:=p95;
+  check(e,round(e),9999999999999);
+  e:=p96;
+  check(e,round(e),9999999999999);
+  e:=n00;
+  check(e,round(e),0);
+  e:=n04;
+  check(e,round(e),0);
+  e:=n05;
+  check(e,round(e),0);
+  e:=n06;
+  check(e,round(e),0);
+  e:=n10;
+  check(e,round(e),-1);
+  e:=n14;
+  check(e,round(e),-1);
+  e:=n15;
+  check(e,round(e),-1);
+  e:=n16;
+  check(e,round(e),-1);
+  e:=n20;
+  check(e,round(e),-2);
+  e:=n24;
+  check(e,round(e),-2);
+  e:=n25;
+  check(e,round(e),-2);
+  e:=n26;
+  check(e,round(e),-2);
+  e:=n80;
+  check(e,round(e),-9999999999998);
+  e:=n84;
+  check(e,round(e),-9999999999998);
+  e:=n85;
+  check(e,round(e),-9999999999998);
+  e:=n86;
+  check(e,round(e),-9999999999998);
+  e:=n90;
+  check(e,round(e),-9999999999999);
+  e:=n94;
+  check(e,round(e),-9999999999999);
+  e:=n95;
+  check(e,round(e),-9999999999999);
+  e:=n96;
+  check(e,round(e),-9999999999999);
+end;
+
+
+begin
+  writeln('Testing default rounding mode');
+  testconstrndnearest;
+  testvarrndnearest;
+
+  SetRoundMode(rmNearest);
+  writeln('Testing round to nearest/even (should be same as default)');
+  testconstrndnearest;
+  testvarrndnearest;
+
+  SetRoundMode(rmUp);
+  writeln('Testing round up');
+  testconstrndnearest;
+  testvarrndup;
+
+  SetRoundMode(rmDown);
+  writeln('Testing round down');
+  testconstrndnearest;
+  testvarrnddown;
+
+  SetRoundMode(rmTruncate);
+  writeln('Testing round to zero (truncate)');
+  testconstrndnearest;
+  testvarrndtrunc;
+end.