diff --git a/.gitattributes b/.gitattributes index 68f89dd9f9..de66b41f6e 100644 --- a/.gitattributes +++ b/.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 diff --git a/rtl/arm/mathu.inc b/rtl/arm/mathu.inc index 0bdba8dc9b..ec02c7e8ec 100644 --- a/rtl/arm/mathu.inc +++ b/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); diff --git a/rtl/inc/cgenmath.inc b/rtl/inc/cgenmath.inc index a139df3b2e..7dc83c4a26 100644 --- a/rtl/inc/cgenmath.inc +++ b/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} diff --git a/rtl/inc/genmath.inc b/rtl/inc/genmath.inc index 970b68b6d7..64a47e290b 100644 --- a/rtl/inc/genmath.inc +++ b/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} diff --git a/rtl/powerpc/mathu.inc b/rtl/powerpc/mathu.inc index 2958b9348e..890ae34b44 100644 --- a/rtl/powerpc/mathu.inc +++ b/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; diff --git a/rtl/powerpc64/mathu.inc b/rtl/powerpc64/mathu.inc index 2958b9348e..772a6ebcf6 100644 --- a/rtl/powerpc64/mathu.inc +++ b/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; diff --git a/rtl/sparc/mathu.inc b/rtl/sparc/mathu.inc index 6fb62ff8e4..af8e596288 100644 --- a/rtl/sparc/mathu.inc +++ b/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; diff --git a/tests/webtbs/tw11392.pp b/tests/webtbs/tw11392.pp new file mode 100644 index 0000000000..4012acf020 --- /dev/null +++ b/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.