t/op/arith.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use Config;
   9
  10 print "1..134\n";
  11
  12 sub try ($$) {
  13    print +($_[1] ? "ok" : "not ok"), " $_[0]\n";
  14 }
  15 sub tryeq ($$$) {
  16   if ($_[1] == $_[2]) {
  17     print "ok $_[0]\n";
  18   } else {
  19     print "not ok $_[0] # $_[1] != $_[2]\n";
  20   }
  21 }
  22 sub tryeq_sloppy ($$$) {
  23   if ($_[1] == $_[2]) {
  24     print "ok $_[0]\n";
  25   } else {
  26     my $error = abs ($_[1] - $_[2]) / $_[1];
  27     if ($error < 1e-9) {
  28       print "ok $_[0] # $_[1] is close to $_[2], \$^O eq $^O\n";
  29     } else {
  30       print "not ok $_[0] # $_[1] != $_[2]\n";
  31     }
  32   }
  33 }
  34
  35 tryeq 1,  13 %  4, 1;
  36 tryeq 2, -13 %  4, 3;
  37 tryeq 3,  13 % -4, -3;
  38 tryeq 4, -13 % -4, -1;
  39
  40 my $limit = 1e6;
  41
  42 # Division (and modulo) of floating point numbers
  43 # seem to be rather sloppy in Cray.
  44 $limit = 1e8 if $^O eq 'unicos';
  45
  46 try 5, abs( 13e21 %  4e21 -  1e21) < $limit;
  47 try 6, abs(-13e21 %  4e21 -  3e21) < $limit;
  48 try 7, abs( 13e21 % -4e21 - -3e21) < $limit;
  49 try 8, abs(-13e21 % -4e21 - -1e21) < $limit;
  50
  51 # UVs should behave properly
  52
  53 tryeq 9, 4063328477 % 65535, 27407;
  54 tryeq 10, 4063328477 % 4063328476, 1;
  55 tryeq 11, 4063328477 % 2031664238, 1;
  56 tryeq 12, 2031664238 % 4063328477, 2031664238;
  57
  58 # These should trigger wrapping on 32 bit IVs and UVs
  59
  60 tryeq 13, 2147483647 + 0, 2147483647;
  61
  62 # IV + IV promote to UV
  63 tryeq 14, 2147483647 + 1, 2147483648;
  64 tryeq 15, 2147483640 + 10, 2147483650;
  65 tryeq 16, 2147483647 + 2147483647, 4294967294;
  66 # IV + UV promote to NV
  67 tryeq 17, 2147483647 + 2147483649, 4294967296;
  68 # UV + IV promote to NV
  69 tryeq 18, 4294967294 + 2, 4294967296;
  70 # UV + UV promote to NV
  71 tryeq 19, 4294967295 + 4294967295, 8589934590;
  72
  73 # UV + IV to IV
  74 tryeq 20, 2147483648 + -1, 2147483647;
  75 tryeq 21, 2147483650 + -10, 2147483640;
  76 # IV + UV to IV
  77 tryeq 22, -1 + 2147483648, 2147483647;
  78 tryeq 23, -10 + 4294967294, 4294967284;
  79 # IV + IV to NV
  80 tryeq 24, -2147483648 + -2147483648, -4294967296;
  81 tryeq 25, -2147483640 + -10, -2147483650;
  82
  83 # Hmm. Don't forget the simple stuff
  84 tryeq 26, 1 + 1, 2;
  85 tryeq 27, 4 + -2, 2;
  86 tryeq 28, -10 + 100, 90;
  87 tryeq 29, -7 + -9, -16;
  88 tryeq 30, -63 + +2, -61;
  89 tryeq 31, 4 + -1, 3;
  90 tryeq 32, -1 + 1, 0;
  91 tryeq 33, +29 + -29, 0;
  92 tryeq 34, -1 + 4, 3;
  93 tryeq 35, +4 + -17, -13;
  94
  95 # subtraction
  96 tryeq 36, 3 - 1, 2;
  97 tryeq 37, 3 - 15, -12;
  98 tryeq 38, 3 - -7, 10;
  99 tryeq 39, -156 - 5, -161;
 100 tryeq 40, -156 - -5, -151;
 101 tryeq 41, -5 - -12, 7;
 102 tryeq 42, -3 - -3, 0;
 103 tryeq 43, 15 - 15, 0;
 104
 105 tryeq 44, 2147483647 - 0, 2147483647;
 106 tryeq 45, 2147483648 - 0, 2147483648;
 107 tryeq 46, -2147483648 - 0, -2147483648;
 108
 109 tryeq 47, 0 - -2147483647, 2147483647;
 110 tryeq 48, -1 - -2147483648, 2147483647;
 111 tryeq 49, 2 - -2147483648, 2147483650;
 112
 113 tryeq 50, 4294967294 - 3, 4294967291;
 114 tryeq 51, -2147483648 - -1, -2147483647;
 115
 116 # IV - IV promote to UV
 117 tryeq 52, 2147483647 - -1, 2147483648;
 118 tryeq 53, 2147483647 - -2147483648, 4294967295;
 119 # UV - IV promote to NV
 120 tryeq 54, 4294967294 - -3, 4294967297;
 121 # IV - IV promote to NV
 122 tryeq 55, -2147483648 - +1, -2147483649;
 123 # UV - UV promote to IV
 124 tryeq 56, 2147483648 - 2147483650, -2;
 125 # IV - UV promote to IV
 126 tryeq 57, 2000000000 - 4000000000, -2000000000;
 127
 128 # No warnings should appear;
 129 my $a;
 130 $a += 1;
 131 tryeq 58, $a, 1;
 132 undef $a;
 133 $a += -1;
 134 tryeq 59, $a, -1;
 135 undef $a;
 136 $a += 4294967290;
 137 tryeq 60, $a, 4294967290;
 138 undef $a;
 139 $a += -4294967290;
 140 tryeq 61, $a, -4294967290;
 141 undef $a;
 142 $a += 4294967297;
 143 tryeq 62, $a, 4294967297;
 144 undef $a;
 145 $a += -4294967297;
 146 tryeq 63, $a, -4294967297;
 147
 148 my $s;
 149 $s -= 1;
 150 tryeq 64, $s, -1;
 151 undef $s;
 152 $s -= -1;
 153 tryeq 65, $s, +1;
 154 undef $s;
 155 $s -= -4294967290;
 156 tryeq 66, $s, +4294967290;
 157 undef $s;
 158 $s -= 4294967290;
 159 tryeq 67, $s, -4294967290;
 160 undef $s;
 161 $s -= 4294967297;
 162 tryeq 68, $s, -4294967297;
 163 undef $s;
 164 $s -= -4294967297;
 165 tryeq 69, $s, +4294967297;
 166
 167 # Multiplication
 168
 169 tryeq 70, 1 * 3, 3;
 170 tryeq 71, -2 * 3, -6;
 171 tryeq 72, 3 * -3, -9;
 172 tryeq 73, -4 * -3, 12;
 173
 174 # check with 0xFFFF and 0xFFFF
 175 tryeq 74, 65535 * 65535, 4294836225;
 176 tryeq 75, 65535 * -65535, -4294836225;
 177 tryeq 76, -65535 * 65535, -4294836225;
 178 tryeq 77, -65535 * -65535, 4294836225;
 179
 180 # check with 0xFFFF and 0x10001
 181 tryeq 78, 65535 * 65537, 4294967295;
 182 tryeq 79, 65535 * -65537, -4294967295;
 183 tryeq 80, -65535 * 65537, -4294967295;
 184 tryeq 81, -65535 * -65537, 4294967295;
 185
 186 # check with 0x10001 and 0xFFFF
 187 tryeq 82, 65537 * 65535, 4294967295;
 188 tryeq 83, 65537 * -65535, -4294967295;
 189 tryeq 84, -65537 * 65535, -4294967295;
 190 tryeq 85, -65537 * -65535, 4294967295;
 191
 192 # These should all be dones as NVs
 193 tryeq 86, 65537 * 65537, 4295098369;
 194 tryeq 87, 65537 * -65537, -4295098369;
 195 tryeq 88, -65537 * 65537, -4295098369;
 196 tryeq 89, -65537 * -65537, 4295098369;
 197
 198 # will overflow an IV (in 32-bit)
 199 tryeq 90, 46340 * 46342, 0x80001218;
 200 tryeq 91, 46340 * -46342, -0x80001218;
 201 tryeq 92, -46340 * 46342, -0x80001218;
 202 tryeq 93, -46340 * -46342, 0x80001218;
 203
 204 tryeq 94, 46342 * 46340, 0x80001218;
 205 tryeq 95, 46342 * -46340, -0x80001218;
 206 tryeq 96, -46342 * 46340, -0x80001218;
 207 tryeq 97, -46342 * -46340, 0x80001218;
 208
 209 # will overflow a positive IV (in 32-bit)
 210 tryeq 98, 65536 * 32768, 0x80000000;
 211 tryeq 99, 65536 * -32768, -0x80000000;
 212 tryeq 100, -65536 * 32768, -0x80000000;
 213 tryeq 101, -65536 * -32768, 0x80000000;
 214
 215 tryeq 102, 32768 * 65536, 0x80000000;
 216 tryeq 103, 32768 * -65536, -0x80000000;
 217 tryeq 104, -32768 * 65536, -0x80000000;
 218 tryeq 105, -32768 * -65536, 0x80000000;
 219
 220 # 2147483647 is prime. bah.
 221
 222 tryeq 106, 46339 * 46341, 0x7ffea80f;
 223 tryeq 107, 46339 * -46341, -0x7ffea80f;
 224 tryeq 108, -46339 * 46341, -0x7ffea80f;
 225 tryeq 109, -46339 * -46341, 0x7ffea80f;
 226
 227 # leading space should be ignored
 228
 229 tryeq 110, 1 + " 1", 2;
 230 tryeq 111, 3 + " -1", 2;
 231 tryeq 112, 1.2, " 1.2";
 232 tryeq 113, -1.2, " -1.2";
 233
 234 # divide
 235
 236 tryeq 114, 28/14, 2;
 237 tryeq 115, 28/-7, -4;
 238 tryeq 116, -28/4, -7;
 239 tryeq 117, -28/-2, 14;
 240
 241 tryeq 118, 0x80000000/1, 0x80000000;
 242 tryeq 119, 0x80000000/-1, -0x80000000;
 243 tryeq 120, -0x80000000/1, -0x80000000;
 244 tryeq 121, -0x80000000/-1, 0x80000000;
 245
 246 # The example for sloppy divide, rigged to avoid the peephole optimiser.
 247 tryeq_sloppy 122, "20." / "5.", 4;
 248
 249 tryeq 123, 2.5 / 2, 1.25;
 250 tryeq 124, 3.5 / -2, -1.75;
 251 tryeq 125, -4.5 / 2, -2.25;
 252 tryeq 126, -5.5 / -2, 2.75;
 253
 254 # Bluuurg if your floating point can't accurately cope with powers of 2
 255 # [I suspect this is parsing string->float problems, not actual arith]
 256 tryeq_sloppy 127, 18446744073709551616/1, 18446744073709551616; # Bluuurg
 257 tryeq_sloppy 128, 18446744073709551616/2, 9223372036854775808;
 258 tryeq_sloppy 129, 18446744073709551616/4294967296, 4294967296;
 259 tryeq_sloppy 130, 18446744073709551616/9223372036854775808, 2;
 260
 261 {
 262   # The peephole optimiser is wrong to think that it can substitute intops
 263   # in place of regular ops, because i_multiply can overflow.
 264   # Bug reported by "Sisyphus" <kalinabears@hdc.com.au>
 265   my $n = 1127;
 266
 267   my $float = ($n % 1000) * 167772160.0;
 268   tryeq_sloppy 131, $float, 21307064320;
 269
 270   # On a 32 bit machine, if the i_multiply op is used, you will probably get
 271   # -167772160. It's actually undefined behaviour, so anything may happen.
 272   my $int = ($n % 1000) * 167772160;
 273   tryeq 132, $int, 21307064320;
 274
 275   my $t = time;
 276   my $t1000 = time() * 1000;
 277   try 133, abs($t1000 -1000 * $t) <= 2000;
 278 }
 279
 280 if ($^O eq 'vos') {
 281   print "not ok 134 # TODO VOS raises SIGFPE instead of producing infinity.\n";
 282 }
 283 elsif (($^O eq 'VMS') && !defined($Config{useieee})) {
 284   print "ok 134 # SKIP -- the IEEE infinity model is unavailable in this configuration.\n";
 285 }
 286 else {
 287   # The computation of $v should overflow and produce "infinity"
 288   # on any system whose max exponent is less than 10**1506.
 289   # The exact string used to represent infinity varies by OS,
 290   # so we don't test for it; all we care is that we don't die.
 291   #
 292   # Perl considers it to be an error if SIGFPE is raised.
 293   # Chances are the interpreter will die, since it doesn't set
 294   # up a handler for SIGFPE.  That's why this test is last; to
 295   # minimize the number of test failures.  --PG
 296
 297   my $n = 5000;
 298   my $v = 2;
 299   while (--$n)
 300   {
 301     $v *= 2;
 302   }
 303   print "ok 134\n";
 304 }