t/op/arith.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 print "1..167\n";
   9
  10 sub try ($$) {
  11    print +($_[1] ? "ok" : "not ok"), " $_[0]\n";
  12 }
  13 sub tryeq ($$$) {
  14   if ($_[1] == $_[2]) {
  15     print "ok $_[0]\n";
  16   } else {
  17     print "not ok $_[0] # $_[1] != $_[2]\n";
  18   }
  19 }
  20 sub tryeq_sloppy ($$$) {
  21   if ($_[1] == $_[2]) {
  22     print "ok $_[0]\n";
  23   } else {
  24     my $error = abs (($_[1] - $_[2]) / $_[1]);
  25     if ($error < 1e-9) {
  26       print "ok $_[0] # $_[1] is close to $_[2], \$^O eq $^O\n";
  27     } else {
  28       print "not ok $_[0] # $_[1] != $_[2]\n";
  29     }
  30   }
  31 }
  32
  33 my $T = 1;
  34 tryeq $T++,  13 %  4, 1;
  35 tryeq $T++, -13 %  4, 3;
  36 tryeq $T++,  13 % -4, -3;
  37 tryeq $T++, -13 % -4, -1;
  38
  39 # Give abs() a good work-out before using it in anger
  40 tryeq $T++, abs(0), 0;
  41 tryeq $T++, abs(1), 1;
  42 tryeq $T++, abs(-1), 1;
  43 tryeq $T++, abs(2147483647), 2147483647;
  44 tryeq $T++, abs(-2147483647), 2147483647;
  45 tryeq $T++, abs(4294967295), 4294967295;
  46 tryeq $T++, abs(-4294967295), 4294967295;
  47 tryeq $T++, abs(9223372036854775807), 9223372036854775807;
  48 tryeq $T++, abs(-9223372036854775807), 9223372036854775807;
  49 tryeq $T++, abs(1e50), 1e50;    # Assume no change whatever; no slop needed
  50 tryeq $T++, abs(-1e50), 1e50;   # Assume only sign bit flipped
  51
  52 my $limit = 1e6;
  53
  54 # Division (and modulo) of floating point numbers
  55 # seem to be rather sloppy in Cray.
  56 $limit = 1e8 if $^O eq 'unicos';
  57
  58 try $T++, abs( 13e21 %  4e21 -  1e21) < $limit;
  59 try $T++, abs(-13e21 %  4e21 -  3e21) < $limit;
  60 try $T++, abs( 13e21 % -4e21 - -3e21) < $limit;
  61 try $T++, abs(-13e21 % -4e21 - -1e21) < $limit;
  62
  63 # UVs should behave properly
  64
  65 tryeq $T++, 4063328477 % 65535, 27407;
  66 tryeq $T++, 4063328477 % 4063328476, 1;
  67 tryeq $T++, 4063328477 % 2031664238, 1;
  68 tryeq $T++, 2031664238 % 4063328477, 2031664238;
  69
  70 # These should trigger wrapping on 32 bit IVs and UVs
  71
  72 tryeq $T++, 2147483647 + 0, 2147483647;
  73
  74 # IV + IV promote to UV
  75 tryeq $T++, 2147483647 + 1, 2147483648;
  76 tryeq $T++, 2147483640 + 10, 2147483650;
  77 tryeq $T++, 2147483647 + 2147483647, 4294967294;
  78 # IV + UV promote to NV
  79 tryeq $T++, 2147483647 + 2147483649, 4294967296;
  80 # UV + IV promote to NV
  81 tryeq $T++, 4294967294 + 2, 4294967296;
  82 # UV + UV promote to NV
  83 tryeq $T++, 4294967295 + 4294967295, 8589934590;
  84
  85 # UV + IV to IV
  86 tryeq $T++, 2147483648 + -1, 2147483647;
  87 tryeq $T++, 2147483650 + -10, 2147483640;
  88 # IV + UV to IV
  89 tryeq $T++, -1 + 2147483648, 2147483647;
  90 tryeq $T++, -10 + 4294967294, 4294967284;
  91 # IV + IV to NV
  92 tryeq $T++, -2147483648 + -2147483648, -4294967296;
  93 tryeq $T++, -2147483640 + -10, -2147483650;
  94
  95 # Hmm. Don't forget the simple stuff
  96 tryeq $T++, 1 + 1, 2;
  97 tryeq $T++, 4 + -2, 2;
  98 tryeq $T++, -10 + 100, 90;
  99 tryeq $T++, -7 + -9, -16;
 100 tryeq $T++, -63 + +2, -61;
 101 tryeq $T++, 4 + -1, 3;
 102 tryeq $T++, -1 + 1, 0;
 103 tryeq $T++, +29 + -29, 0;
 104 tryeq $T++, -1 + 4, 3;
 105 tryeq $T++, +4 + -17, -13;
 106
 107 # subtraction
 108 tryeq $T++, 3 - 1, 2;
 109 tryeq $T++, 3 - 15, -12;
 110 tryeq $T++, 3 - -7, 10;
 111 tryeq $T++, -156 - 5, -161;
 112 tryeq $T++, -156 - -5, -151;
 113 tryeq $T++, -5 - -12, 7;
 114 tryeq $T++, -3 - -3, 0;
 115 tryeq $T++, 15 - 15, 0;
 116
 117 tryeq $T++, 2147483647 - 0, 2147483647;
 118 tryeq $T++, 2147483648 - 0, 2147483648;
 119 tryeq $T++, -2147483648 - 0, -2147483648;
 120
 121 tryeq $T++, 0 - -2147483647, 2147483647;
 122 tryeq $T++, -1 - -2147483648, 2147483647;
 123 tryeq $T++, 2 - -2147483648, 2147483650;
 124
 125 tryeq $T++, 4294967294 - 3, 4294967291;
 126 tryeq $T++, -2147483648 - -1, -2147483647;
 127
 128 # IV - IV promote to UV
 129 tryeq $T++, 2147483647 - -1, 2147483648;
 130 tryeq $T++, 2147483647 - -2147483648, 4294967295;
 131 # UV - IV promote to NV
 132 tryeq $T++, 4294967294 - -3, 4294967297;
 133 # IV - IV promote to NV
 134 tryeq $T++, -2147483648 - +1, -2147483649;
 135 # UV - UV promote to IV
 136 tryeq $T++, 2147483648 - 2147483650, -2;
 137 # IV - UV promote to IV
 138 tryeq $T++, 2000000000 - 4000000000, -2000000000;
 139
 140 # No warnings should appear;
 141 my $a;
 142 $a += 1;
 143 tryeq $T++, $a, 1;
 144 undef $a;
 145 $a += -1;
 146 tryeq $T++, $a, -1;
 147 undef $a;
 148 $a += 4294967290;
 149 tryeq $T++, $a, 4294967290;
 150 undef $a;
 151 $a += -4294967290;
 152 tryeq $T++, $a, -4294967290;
 153 undef $a;
 154 $a += 4294967297;
 155 tryeq $T++, $a, 4294967297;
 156 undef $a;
 157 $a += -4294967297;
 158 tryeq $T++, $a, -4294967297;
 159
 160 my $s;
 161 $s -= 1;
 162 tryeq $T++, $s, -1;
 163 undef $s;
 164 $s -= -1;
 165 tryeq $T++, $s, +1;
 166 undef $s;
 167 $s -= -4294967290;
 168 tryeq $T++, $s, +4294967290;
 169 undef $s;
 170 $s -= 4294967290;
 171 tryeq $T++, $s, -4294967290;
 172 undef $s;
 173 $s -= 4294967297;
 174 tryeq $T++, $s, -4294967297;
 175 undef $s;
 176 $s -= -4294967297;
 177 tryeq $T++, $s, +4294967297;
 178
 179 # Multiplication
 180
 181 tryeq $T++, 1 * 3, 3;
 182 tryeq $T++, -2 * 3, -6;
 183 tryeq $T++, 3 * -3, -9;
 184 tryeq $T++, -4 * -3, 12;
 185
 186 # check with 0xFFFF and 0xFFFF
 187 tryeq $T++, 65535 * 65535, 4294836225;
 188 tryeq $T++, 65535 * -65535, -4294836225;
 189 tryeq $T++, -65535 * 65535, -4294836225;
 190 tryeq $T++, -65535 * -65535, 4294836225;
 191
 192 # check with 0xFFFF and 0x10001
 193 tryeq $T++, 65535 * 65537, 4294967295;
 194 tryeq $T++, 65535 * -65537, -4294967295;
 195 tryeq $T++, -65535 * 65537, -4294967295;
 196 tryeq $T++, -65535 * -65537, 4294967295;
 197
 198 # check with 0x10001 and 0xFFFF
 199 tryeq $T++, 65537 * 65535, 4294967295;
 200 tryeq $T++, 65537 * -65535, -4294967295;
 201 tryeq $T++, -65537 * 65535, -4294967295;
 202 tryeq $T++, -65537 * -65535, 4294967295;
 203
 204 # These should all be dones as NVs
 205 tryeq $T++, 65537 * 65537, 4295098369;
 206 tryeq $T++, 65537 * -65537, -4295098369;
 207 tryeq $T++, -65537 * 65537, -4295098369;
 208 tryeq $T++, -65537 * -65537, 4295098369;
 209
 210 # will overflow an IV (in 32-bit)
 211 tryeq $T++, 46340 * 46342, 0x80001218;
 212 tryeq $T++, 46340 * -46342, -0x80001218;
 213 tryeq $T++, -46340 * 46342, -0x80001218;
 214 tryeq $T++, -46340 * -46342, 0x80001218;
 215
 216 tryeq $T++, 46342 * 46340, 0x80001218;
 217 tryeq $T++, 46342 * -46340, -0x80001218;
 218 tryeq $T++, -46342 * 46340, -0x80001218;
 219 tryeq $T++, -46342 * -46340, 0x80001218;
 220
 221 # will overflow a positive IV (in 32-bit)
 222 tryeq $T++, 65536 * 32768, 0x80000000;
 223 tryeq $T++, 65536 * -32768, -0x80000000;
 224 tryeq $T++, -65536 * 32768, -0x80000000;
 225 tryeq $T++, -65536 * -32768, 0x80000000;
 226
 227 tryeq $T++, 32768 * 65536, 0x80000000;
 228 tryeq $T++, 32768 * -65536, -0x80000000;
 229 tryeq $T++, -32768 * 65536, -0x80000000;
 230 tryeq $T++, -32768 * -65536, 0x80000000;
 231
 232 # 2147483647 is prime. bah.
 233
 234 tryeq $T++, 46339 * 46341, 0x7ffea80f;
 235 tryeq $T++, 46339 * -46341, -0x7ffea80f;
 236 tryeq $T++, -46339 * 46341, -0x7ffea80f;
 237 tryeq $T++, -46339 * -46341, 0x7ffea80f;
 238
 239 # leading space should be ignored
 240
 241 tryeq $T++, 1 + " 1", 2;
 242 tryeq $T++, 3 + " -1", 2;
 243 tryeq $T++, 1.2, " 1.2";
 244 tryeq $T++, -1.2, " -1.2";
 245
 246 # divide
 247
 248 tryeq $T++, 28/14, 2;
 249 tryeq $T++, 28/-7, -4;
 250 tryeq $T++, -28/4, -7;
 251 tryeq $T++, -28/-2, 14;
 252
 253 tryeq $T++, 0x80000000/1, 0x80000000;
 254 tryeq $T++, 0x80000000/-1, -0x80000000;
 255 tryeq $T++, -0x80000000/1, -0x80000000;
 256 tryeq $T++, -0x80000000/-1, 0x80000000;
 257
 258 # The example for sloppy divide, rigged to avoid the peephole optimiser.
 259 tryeq_sloppy $T++, "20." / "5.", 4;
 260
 261 tryeq $T++, 2.5 / 2, 1.25;
 262 tryeq $T++, 3.5 / -2, -1.75;
 263 tryeq $T++, -4.5 / 2, -2.25;
 264 tryeq $T++, -5.5 / -2, 2.75;
 265
 266 # Bluuurg if your floating point can't accurately cope with powers of 2
 267 # [I suspect this is parsing string->float problems, not actual arith]
 268 tryeq_sloppy $T++, 18446744073709551616/1, 18446744073709551616; # Bluuurg
 269 tryeq_sloppy $T++, 18446744073709551616/2, 9223372036854775808;
 270 tryeq_sloppy $T++, 18446744073709551616/4294967296, 4294967296;
 271 tryeq_sloppy $T++, 18446744073709551616/9223372036854775808, 2;
 272
 273 {
 274   # The peephole optimiser is wrong to think that it can substitute intops
 275   # in place of regular ops, because i_multiply can overflow.
 276   # Bug reported by "Sisyphus" <kalinabears@hdc.com.au>
 277   my $n = 1127;
 278
 279   my $float = ($n % 1000) * 167772160.0;
 280   tryeq_sloppy $T++, $float, 21307064320;
 281
 282   # On a 32 bit machine, if the i_multiply op is used, you will probably get
 283   # -167772160. It's actually undefined behaviour, so anything may happen.
 284   my $int = ($n % 1000) * 167772160;
 285   tryeq $T++, $int, 21307064320;
 286
 287   my $float2 = ($n % 1000 + 0.0) * 167772160;
 288   tryeq $T++, $float2, 21307064320;
 289
 290   my $int2 = ($n % 1000 + 0) * 167772160;
 291   tryeq $T++, $int2, 21307064320;
 292
 293   # zero, but in a way that ought to be able to defeat any future optimizer:
 294   my $zero = $$ - $$;
 295   my $int3 = ($n % 1000 + $zero) * 167772160;
 296   tryeq $T++, $int3, 21307064320;
 297
 298   my $t = time;
 299   my $t1000 = time() * 1000;
 300   try $T++, abs($t1000 -1000 * $t) <= 2000;
 301 }
 302
 303 {
 304   # 64 bit variants
 305   my $n = 1127;
 306
 307   my $float = ($n % 1000) * 720575940379279360.0;
 308   tryeq_sloppy $T++, $float, 9.15131444281685e+19;
 309
 310   my $int = ($n % 1000) * 720575940379279360;
 311   tryeq_sloppy $T++, $int, 9.15131444281685e+19;
 312
 313   my $float2 = ($n % 1000 + 0.0) * 720575940379279360;
 314   tryeq_sloppy $T++, $float2, 9.15131444281685e+19;
 315
 316   my $int2 = ($n % 1000 + 0) * 720575940379279360;
 317   tryeq_sloppy $T++, $int2, 9.15131444281685e+19;
 318
 319   # zero, but in a way that ought to be able to defeat any future optimizer:
 320   my $zero = $$ - $$;
 321   my $int3 = ($n % 1000 + $zero) * 720575940379279360;
 322   tryeq_sloppy $T++, $int3, 9.15131444281685e+19;
 323 }
 324
 325 my $vms_no_ieee;
 326 if ($^O eq 'VMS') {
 327   use vars '%Config';
 328   eval {require Config; import Config};
 329   $vms_no_ieee = 1 unless defined($Config{useieee});
 330 }
 331
 332 if ($^O eq 'vos') {
 333   print "not ok ", $T++, " # TODO VOS raises SIGFPE instead of producing infinity.\n";
 334 }
 335 elsif ($vms_no_ieee) {
 336  print $T++, " # SKIP -- the IEEE infinity model is unavailable in this configuration.\n"
 337 }
 338 elsif ($^O eq 'ultrix') {
 339   print "not ok ", $T++, " # TODO Ultrix enters deep nirvana instead of producing infinity.\n";
 340 }
 341 else {
 342   # The computation of $v should overflow and produce "infinity"
 343   # on any system whose max exponent is less than 10**1506.
 344   # The exact string used to represent infinity varies by OS,
 345   # so we don't test for it; all we care is that we don't die.
 346   #
 347   # Perl considers it to be an error if SIGFPE is raised.
 348   # Chances are the interpreter will die, since it doesn't set
 349   # up a handler for SIGFPE.  That's why this test is last; to
 350   # minimize the number of test failures.  --PG
 351
 352   my $n = 5000;
 353   my $v = 2;
 354   while (--$n)
 355   {
 356     $v *= 2;
 357   }
 358   print "ok ", $T++, "\n";
 359 }
 360
 361 # [perl #109542] $1 and "$1" should be treated the same way
 362 "976562500000000" =~ /(\d+)/;
 363 $a = ($1 * 1024);
 364 $b = ("$1" * 1024);
 365 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" * something\n';
 366 $a = (1024 * $1);
 367 $b = (1024 * "$1");
 368 print "not "x($a ne $b), "ok ", $T++, qq ' - something * \$1 vs "\$1"\n';
 369 $a = ($1 + 102400000000000);
 370 $b = ("$1" + 102400000000000);
 371 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" + something\n';
 372 $a = (102400000000000 + $1);
 373 $b = (102400000000000 + "$1");
 374 print "not "x($a ne $b), "ok ", $T++, qq ' - something + \$1 vs "\$1"\n';
 375 $a = ($1 - 10240000000000000);
 376 $b = ("$1" - 10240000000000000);
 377 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" - something\n';
 378 $a = (10240000000000000 - $1);
 379 $b = (10240000000000000 - "$1");
 380 print "not "x($a ne $b), "ok ", $T++, qq ' - something - \$1 vs "\$1"\n';
 381 "976562500" =~ /(\d+)/;
 382 $a = ($1 ** 2);
 383 $b = ("$1" ** 2);
 384 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" ** something\n';
 385 "32" =~ /(\d+)/;
 386 $a = (3 ** $1);
 387 $b = (3 ** "$1");
 388 print "not "x($a ne $b), "ok ", $T++, qq ' - something ** \$1 vs "\$1"\n';
 389 "97656250000000000" =~ /(\d+)/;
 390 $a = ($1 / 10);
 391 $b = ("$1" / 10);
 392 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" / something\n';
 393 "10" =~ /(\d+)/;
 394 $a = (97656250000000000 / $1);
 395 $b = (97656250000000000 / "$1");
 396 print "not "x($a ne $b), "ok ", $T++, qq ' - something / \$1 vs "\$1"\n';
 397 "97656250000000000" =~ /(\d+)/;
 398 $a = ($1 <=> 97656250000000001);
 399 $b = ("$1" <=> 97656250000000001);
 400 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" <=> something\n';
 401 $a = (97656250000000001 <=> $1);
 402 $b = (97656250000000001 <=> "$1");
 403 print "not "x($a ne $b), "ok ", $T++, qq ' - something <=> \$1 vs "\$1"\n';
 404 "97656250000000001" =~ /(\d+)/;
 405 $a = ($1 % 97656250000000002);
 406 $b = ("$1" % 97656250000000002);
 407 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" % something\n';
 408 $a = (97656250000000000 % $1);
 409 $b = (97656250000000000 % "$1");
 410 print "not "x($a ne $b), "ok ", $T++, qq ' - something % \$1 vs "\$1"\n';