fpc/tests/webtbs/tw11392.pp
Jonas Maebe 30a51c2dee + support for the different rounding modes in the generic rounding
routines (mantis #11392)

git-svn-id: trunk@11290 -
2008-06-27 17:20:56 +00:00

687 lines
15 KiB
ObjectPascal

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.