123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686 |
- 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.
|