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.