Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
fpc-src / usr / share / fpcsrc / 3.0.0 / tests / webtbs / tw11392.pp
Size: Mime:
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.