t/opbasic/arith.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     require './test.pl';
   6     set_up_inc('../lib');
   7 }
   8
   9 # This file has been placed in t/opbasic to indicate that it should not use
  10 # functions imported from t/test.pl or Test::More, as those programs/libraries
  11 # use operators which are what is being tested in this file.
  12
  13 print "1..189\n";
  14
  15 sub try ($$$) {
  16    print +($_[1] ? "ok" : "not ok") . " $_[0] - $_[2]\n";
  17 }
  18 sub tryeq ($$$$) {
  19   my $status;
  20   if ($_[1] == $_[2]) {
  21     $status = "ok $_[0]";
  22   } else {
  23     $status = "not ok $_[0] # $_[1] != $_[2]";
  24   }
  25   print "$status - $_[3]\n";
  26 }
  27 sub tryeq_sloppy ($$$$) {
  28   my $status;
  29   if ($_[1] == $_[2]) {
  30     $status = "ok $_[0]";
  31   } else {
  32     my $error = abs (($_[1] - $_[2]) / $_[1]);
  33     if ($error < 1e-9) {
  34       $status = "ok $_[0] # $_[1] is close to $_[2], \$^O eq $^O";
  35     } else {
  36       $status = "not ok $_[0] # $_[1] != $_[2]";
  37     }
  38   }
  39   print "$status - $_[3]\n";
  40 }
  41
  42 my $T = 1;
  43 tryeq $T++,  13 %  4, 1, 'modulo: positive positive';
  44 tryeq $T++, -13 %  4, 3, 'modulo: negative positive';
  45 tryeq $T++,  13 % -4, -3, 'modulo: positive negative';
  46 tryeq $T++, -13 % -4, -1, 'modulo: negative negative';
  47
  48 # Exercise some of the dright/dleft logic in pp_modulo
  49
  50 tryeq $T++, 13.333333 % 5.333333, 3, 'modulo: 13.333333 % 5.333333';
  51 tryeq $T++, 13.333333 % 5,        3, 'modulo: 13.333333 % 5';
  52 tryeq $T++, 13 % 5.333333,        3, 'modulo: 13 % 5.333333';
  53
  54 # Give abs() a good work-out before using it in anger
  55 tryeq $T++, abs(0), 0, 'abs(): 0 0';
  56 tryeq $T++, abs(1), 1, 'abs(): 1 1';
  57 tryeq $T++, abs(-1), 1, 'abs(): -1 1';
  58 tryeq $T++, abs(2147483647), 2147483647, 'abs(): 2**31-1: pos pos';
  59 tryeq $T++, abs(-2147483647), 2147483647, 'abs(): 2**31-1: neg pos';
  60 tryeq $T++, abs(4294967295), 4294967295, 'abs(): 2**32-1: pos pos';
  61 tryeq $T++, abs(-4294967295), 4294967295, 'abs(): 2**32-1: neg pos';
  62 tryeq $T++, abs(9223372036854775807), 9223372036854775807,
  63     'abs(): 2**63-1: pos pos';
  64 tryeq $T++, abs(-9223372036854775807), 9223372036854775807,
  65     'abs(): 2**63-1: neg pos';
  66 # Assume no change whatever; no slop needed
  67 tryeq $T++, abs(1e50), 1e50, 'abs(): 1e50: pos pos';
  68 # Assume only sign bit flipped
  69 tryeq $T++, abs(-1e50), 1e50, 'abs(): 1e50: neg pos';
  70
  71 my $limit = 1e6;
  72
  73 # Division (and modulo) of floating point numbers
  74 # seem to be rather sloppy in Cray.
  75 $limit = 1e8 if $^O eq 'unicos';
  76
  77 try $T++, abs( 13e21 %  4e21 -  1e21) < $limit, 'abs() for floating point';
  78 try $T++, abs(-13e21 %  4e21 -  3e21) < $limit, 'abs() for floating point';
  79 try $T++, abs( 13e21 % -4e21 - -3e21) < $limit, 'abs() for floating point';
  80 try $T++, abs(-13e21 % -4e21 - -1e21) < $limit, 'abs() for floating point';
  81
  82 tryeq $T++, 4063328477 % 65535, 27407, 'UV behaves properly: modulo';
  83 tryeq $T++, 4063328477 % 4063328476, 1, 'UV behaves properly: modulo';
  84 tryeq $T++, 4063328477 % 2031664238, 1, 'UV behaves properly: modulo';
  85 tryeq $T++, 2031664238 % 4063328477, 2031664238,
  86     'UV behaves properly: modulo';
  87
  88 tryeq $T++, 2147483647 + 0, 2147483647,
  89     'trigger wrapping on 32 bit IVs and UVs';
  90
  91 tryeq $T++, 2147483647 + 1, 2147483648, 'IV + IV promotes to UV';
  92 tryeq $T++, 2147483640 + 10, 2147483650, 'IV + IV promotes to UV';
  93 tryeq $T++, 2147483647 + 2147483647, 4294967294, 'IV + IV promotes to UV';
  94 tryeq $T++, 2147483647 + 2147483649, 4294967296, 'IV + UV promotes to NV';
  95 tryeq $T++, 4294967294 + 2, 4294967296, 'UV + IV promotes to NV';
  96 tryeq $T++, 4294967295 + 4294967295, 8589934590, 'UV + UV promotes to NV';
  97
  98 tryeq $T++, 2147483648 + -1, 2147483647, 'UV + IV promotes to IV';
  99 tryeq $T++, 2147483650 + -10, 2147483640, 'UV + IV promotes to IV';
 100 tryeq $T++, -1 + 2147483648, 2147483647, 'IV + UV promotes to IV';
 101 tryeq $T++, -10 + 4294967294, 4294967284, 'IV + UV promotes to IV';
 102 tryeq $T++, -2147483648 + -2147483648, -4294967296, 'IV + IV promotes to NV';
 103 tryeq $T++, -2147483640 + -10, -2147483650, 'IV + IV promotes to NV';
 104
 105 # Hmm. Do not forget the simple stuff
 106 # addition
 107 tryeq $T++, 1 + 1, 2, 'addition of 2 positive integers';
 108 tryeq $T++, 4 + -2, 2, 'addition of positive and negative integer';
 109 tryeq $T++, -10 + 100, 90, 'addition of negative and positive integer';
 110 tryeq $T++, -7 + -9, -16, 'addition of 2 negative integers';
 111 tryeq $T++, -63 + +2, -61, 'addition of signed negative and positive integers';
 112 tryeq $T++, 4 + -1, 3, 'addition of positive and negative integer';
 113 tryeq $T++, -1 + 1, 0, 'addition which sums to 0';
 114 tryeq $T++, +29 + -29, 0, 'addition which sums to 0';
 115 tryeq $T++, -1 + 4, 3, 'addition of signed negative and positive integers';
 116 tryeq $T++, +4 + -17, -13, 'addition of signed positive and negative integers';
 117
 118 # subtraction
 119 tryeq $T++, 3 - 1, 2, 'subtraction of two positive integers';
 120 tryeq $T++, 3 - 15, -12,
 121     'subtraction of two positive integers: minuend smaller';
 122 tryeq $T++, 3 - -7, 10, 'subtraction of positive and negative integer';
 123 tryeq $T++, -156 - 5, -161, 'subtraction of negative and positive integer';
 124 tryeq $T++, -156 - -5, -151, 'subtraction of two negative integers';
 125 tryeq $T++, -5 - -12, 7,
 126     'subtraction of two negative integers: minuend smaller';
 127 tryeq $T++, -3 - -3, 0, 'subtraction of two negative integers with result of 0';
 128 tryeq $T++, 15 - 15, 0, 'subtraction of two positive integers with result of 0';
 129 tryeq $T++, 2147483647 - 0, 2147483647, 'subtraction from large integer';
 130 tryeq $T++, 2147483648 - 0, 2147483648, 'subtraction from large integer';
 131 tryeq $T++, -2147483648 - 0, -2147483648,
 132     'subtraction from large negative integer';
 133 tryeq $T++, 0 - -2147483647, 2147483647,
 134     'subtraction of large negative integer from 0';
 135 tryeq $T++, -1 - -2147483648, 2147483647,
 136     'subtraction of large negative integer from negative integer';
 137 tryeq $T++, 2 - -2147483648, 2147483650,
 138     'subtraction of large negative integer from positive integer';
 139 tryeq $T++, 4294967294 - 3, 4294967291, 'subtraction from large integer';
 140 tryeq $T++, -2147483648 - -1, -2147483647,
 141     'subtraction from large negative integer';
 142 tryeq $T++, 2147483647 - -1, 2147483648, 'IV - IV promote to UV';
 143 tryeq $T++, 2147483647 - -2147483648, 4294967295, 'IV - IV promote to UV';
 144 tryeq $T++, 4294967294 - -3, 4294967297, 'UV - IV promote to NV';
 145 tryeq $T++, -2147483648 - +1, -2147483649, 'IV - IV promote to NV';
 146 tryeq $T++, 2147483648 - 2147483650, -2, 'UV - UV promote to IV';
 147 tryeq $T++, 2000000000 - 4000000000, -2000000000, 'IV - UV promote to IV';
 148
 149 # No warnings should appear;
 150 my $a;
 151 $a += 1;
 152 tryeq $T++, $a, 1, '+= with positive';
 153 undef $a;
 154 $a += -1;
 155 tryeq $T++, $a, -1, '+= with negative';
 156 undef $a;
 157 $a += 4294967290;
 158 tryeq $T++, $a, 4294967290, '+= with positive';
 159 undef $a;
 160 $a += -4294967290;
 161 tryeq $T++, $a, -4294967290, '+= with negative';
 162 undef $a;
 163 $a += 4294967297;
 164 tryeq $T++, $a, 4294967297, '+= with positive';
 165 undef $a;
 166 $a += -4294967297;
 167 tryeq $T++, $a, -4294967297, '+= with negative';
 168
 169 my $s;
 170 $s -= 1;
 171 tryeq $T++, $s, -1, '-= with positive';
 172 undef $s;
 173 $s -= -1;
 174 tryeq $T++, $s, +1, '-= with negative';
 175 undef $s;
 176 $s -= -4294967290;
 177 tryeq $T++, $s, +4294967290, '-= with negative';
 178 undef $s;
 179 $s -= 4294967290;
 180 tryeq $T++, $s, -4294967290, '-= with negative';
 181 undef $s;
 182 $s -= 4294967297;
 183 tryeq $T++, $s, -4294967297, '-= with positive';
 184 undef $s;
 185 $s -= -4294967297;
 186 tryeq $T++, $s, +4294967297, '-= with positive';
 187
 188 # multiplication
 189 tryeq $T++, 1 * 3, 3, 'multiplication of two positive integers';
 190 tryeq $T++, -2 * 3, -6, 'multiplication of negative and positive integer';
 191 tryeq $T++, 3 * -3, -9, 'multiplication of positive and negative integer';
 192 tryeq $T++, -4 * -3, 12, 'multiplication of two negative integers';
 193
 194 # check with 0xFFFF and 0xFFFF
 195 tryeq $T++, 65535 * 65535, 4294836225,
 196     'multiplication: 0xFFFF and 0xFFFF: pos pos';
 197 tryeq $T++, 65535 * -65535, -4294836225,
 198     'multiplication: 0xFFFF and 0xFFFF: pos neg';
 199 tryeq $T++, -65535 * 65535, -4294836225,
 200     'multiplication: 0xFFFF and 0xFFFF: pos neg';
 201 tryeq $T++, -65535 * -65535, 4294836225,
 202     'multiplication: 0xFFFF and 0xFFFF: neg neg';
 203
 204 # check with 0xFFFF and 0x10001
 205 tryeq $T++, 65535 * 65537, 4294967295,
 206     'multiplication: 0xFFFF and 0x10001: pos pos';
 207 tryeq $T++, 65535 * -65537, -4294967295,
 208     'multiplication: 0xFFFF and 0x10001: pos neg';
 209 tryeq $T++, -65535 * 65537, -4294967295,
 210     'multiplication: 0xFFFF and 0x10001: neg pos';
 211 tryeq $T++, -65535 * -65537, 4294967295,
 212     'multiplication: 0xFFFF and 0x10001: neg neg';
 213
 214 # check with 0x10001 and 0xFFFF
 215 tryeq $T++, 65537 * 65535, 4294967295,
 216     'multiplication: 0x10001 and 0xFFFF: pos pos';
 217 tryeq $T++, 65537 * -65535, -4294967295,
 218     'multiplication: 0x10001 and 0xFFFF: pos neg';
 219 tryeq $T++, -65537 * 65535, -4294967295,
 220     'multiplication: 0x10001 and 0xFFFF: neg pos';
 221 tryeq $T++, -65537 * -65535, 4294967295,
 222     'multiplication: 0x10001 and 0xFFFF: neg neg';
 223
 224 # These should all be dones as NVs
 225 tryeq $T++, 65537 * 65537, 4295098369, 'multiplication: NV: pos pos';
 226 tryeq $T++, 65537 * -65537, -4295098369, 'multiplication: NV: pos neg';
 227 tryeq $T++, -65537 * 65537, -4295098369, 'multiplication: NV: neg pos';
 228 tryeq $T++, -65537 * -65537, 4295098369, 'multiplication: NV: neg neg';
 229
 230 # will overflow an IV (in 32-bit)
 231 tryeq $T++, 46340 * 46342, 0x80001218,
 232     'multiplication: overflow an IV in 32-bit: pos pos';
 233 tryeq $T++, 46340 * -46342, -0x80001218,
 234     'multiplication: overflow an IV in 32-bit: pos neg';
 235 tryeq $T++, -46340 * 46342, -0x80001218,
 236     'multiplication: overflow an IV in 32-bit: neg pos';
 237 tryeq $T++, -46340 * -46342, 0x80001218,
 238     'multiplication: overflow an IV in 32-bit: neg neg';
 239
 240 tryeq $T++, 46342 * 46340, 0x80001218,
 241     'multiplication: overflow an IV in 32-bit: pos pos';
 242 tryeq $T++, 46342 * -46340, -0x80001218,
 243     'multiplication: overflow an IV in 32-bit: pos neg';
 244 tryeq $T++, -46342 * 46340, -0x80001218,
 245     'multiplication: overflow an IV in 32-bit: neg pos';
 246 tryeq $T++, -46342 * -46340, 0x80001218,
 247     'multiplication: overflow an IV in 32-bit: neg neg';
 248
 249 # will overflow a positive IV (in 32-bit)
 250 tryeq $T++, 65536 * 32768, 0x80000000,
 251     'multiplication: overflow a positive IV in 32-bit: pos pos';
 252 tryeq $T++, 65536 * -32768, -0x80000000,
 253     'multiplication: overflow a positive IV in 32-bit: pos neg';
 254 tryeq $T++, -65536 * 32768, -0x80000000,
 255     'multiplication: overflow a positive IV in 32-bit: neg pos';
 256 tryeq $T++, -65536 * -32768, 0x80000000,
 257     'multiplication: overflow a positive IV in 32-bit: neg neg';
 258
 259 tryeq $T++, 32768 * 65536, 0x80000000,
 260     'multiplication: overflow a positive IV in 32-bit: pos pos';
 261 tryeq $T++, 32768 * -65536, -0x80000000,
 262     'multiplication: overflow a positive IV in 32-bit: pos neg';
 263 tryeq $T++, -32768 * 65536, -0x80000000,
 264     'multiplication: overflow a positive IV in 32-bit: neg pos';
 265 tryeq $T++, -32768 * -65536, 0x80000000,
 266     'multiplication: overflow a positive IV in 32-bit: neg neg';
 267
 268 # 2147483647 is prime. bah.
 269
 270 tryeq $T++, 46339 * 46341, 0x7ffea80f,
 271     'multiplication: hex product: pos pos';
 272 tryeq $T++, 46339 * -46341, -0x7ffea80f,
 273     'multiplication: hex product: pos neg';
 274 tryeq $T++, -46339 * 46341, -0x7ffea80f,
 275     'multiplication: hex product: neg pos';
 276 tryeq $T++, -46339 * -46341, 0x7ffea80f,
 277     'multiplication: hex product: neg neg';
 278
 279 # leading space should be ignored
 280
 281 tryeq $T++, 1 + " 1", 2, 'ignore leading space: addition';
 282 tryeq $T++, 3 + " -1", 2, 'ignore leading space: subtraction';
 283 tryeq $T++, 1.2, " 1.2", 'floating point and string equivalent: positive';
 284 tryeq $T++, -1.2, " -1.2", 'floating point and string equivalent: negative';
 285
 286 # division
 287 tryeq $T++, 28/14, 2, 'division of two positive integers';
 288 tryeq $T++, 28/-7, -4, 'division of positive integer by negative';
 289 tryeq $T++, -28/4, -7, 'division of negative integer by positive';
 290 tryeq $T++, -28/-2, 14, 'division of negative integer by negative';
 291
 292 tryeq $T++, 0x80000000/1, 0x80000000,
 293     'division of positive hex by positive integer';
 294 tryeq $T++, 0x80000000/-1, -0x80000000,
 295     'division of positive hex by negative integer';
 296 tryeq $T++, -0x80000000/1, -0x80000000,
 297     'division of negative hex by negative integer';
 298 tryeq $T++, -0x80000000/-1, 0x80000000,
 299     'division of negative hex by positive integer';
 300
 301 # The example for sloppy divide, rigged to avoid the peephole optimiser.
 302 tryeq_sloppy $T++, "20." / "5.", 4, 'division of floating point without fractional part';
 303
 304 tryeq $T++, 2.5 / 2, 1.25,
 305     'division of positive floating point by positive integer';
 306 tryeq $T++, 3.5 / -2, -1.75,
 307     'division of positive floating point by negative integer';
 308 tryeq $T++, -4.5 / 2, -2.25,
 309     'division of negative floating point by positive integer';
 310 tryeq $T++, -5.5 / -2, 2.75,
 311     'division of negative floating point by negative integer';
 312
 313 # Bluuurg if your floating point can not accurately cope with powers of 2
 314 # [I suspect this is parsing string->float problems, not actual arith]
 315 tryeq_sloppy $T++, 18446744073709551616/1, 18446744073709551616,
 316     'division of very large number by 1'; # Bluuurg
 317 tryeq_sloppy $T++, 18446744073709551616/2, 9223372036854775808,
 318     'division of very large number by 2';
 319 tryeq_sloppy $T++, 18446744073709551616/4294967296, 4294967296,
 320     'division of two very large numbers';
 321 tryeq_sloppy $T++, 18446744073709551616/9223372036854775808, 2,
 322     'division of two very large numbers';
 323
 324 {
 325   # The peephole optimiser is wrong to think that it can substitute intops
 326   # in place of regular ops, because i_multiply can overflow.
 327   # Bug reported by "Sisyphus" <kalinabears@hdc.com.au>
 328   my $n = 1127;
 329
 330   my $float = ($n % 1000) * 167772160.0;
 331   tryeq_sloppy $T++, $float, 21307064320, 'integer times floating point';
 332
 333   # On a 32 bit machine, if the i_multiply op is used, you will probably get
 334   # -167772160. It is actually undefined behaviour, so anything may happen.
 335   my $int = ($n % 1000) * 167772160;
 336   tryeq $T++, $int, 21307064320, 'integer times integer';
 337
 338   my $float2 = ($n % 1000 + 0.0) * 167772160;
 339   tryeq $T++, $float2, 21307064320, 'floating point times integer';
 340
 341   my $int2 = ($n % 1000 + 0) * 167772160;
 342   tryeq $T++, $int2, 21307064320, 'integer plus zero times integer';
 343
 344   # zero, but in a way that ought to be able to defeat any future optimizer:
 345   my $zero = $$ - $$;
 346   my $int3 = ($n % 1000 + $zero) * 167772160;
 347   tryeq $T++, $int3, 21307064320, 'defeat any future optimizer';
 348
 349   my $t = time;
 350   my $t1000 = time() * 1000;
 351   try $T++, abs($t1000 -1000 * $t) <= 2000, 'absolute value';
 352 }
 353
 354 {
 355   # 64 bit variants
 356   my $n = 1127;
 357
 358   my $float = ($n % 1000) * 720575940379279360.0;
 359   tryeq_sloppy $T++, $float, 9.15131444281685e+19,
 360     '64 bit: integer times floating point';
 361
 362   my $int = ($n % 1000) * 720575940379279360;
 363   tryeq_sloppy $T++, $int, 9.15131444281685e+19,
 364     '64 bit: integer times integer';
 365
 366   my $float2 = ($n % 1000 + 0.0) * 720575940379279360;
 367   tryeq_sloppy $T++, $float2, 9.15131444281685e+19,
 368     '64 bit: floating point times integer';
 369
 370   my $int2 = ($n % 1000 + 0) * 720575940379279360;
 371   tryeq_sloppy $T++, $int2, 9.15131444281685e+19,
 372     '64 bit: integer plus zero times integer';
 373
 374   # zero, but in a way that ought to be able to defeat any future optimizer:
 375   my $zero = $$ - $$;
 376   my $int3 = ($n % 1000 + $zero) * 720575940379279360;
 377   tryeq_sloppy $T++, $int3, 9.15131444281685e+19,
 378     '64 bit: defeat any future optimizer';
 379 }
 380
 381 # [perl #109542] $1 and "$1" should be treated the same way
 382 "976562500000000" =~ /(\d+)/;
 383 $a = ($1 * 1024);
 384 $b = ("$1" * 1024);
 385 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" * something\n';
 386 $a = (1024 * $1);
 387 $b = (1024 * "$1");
 388 print "not "x($a ne $b), "ok ", $T++, qq ' - something * \$1 vs "\$1"\n';
 389 $a = ($1 + 102400000000000);
 390 $b = ("$1" + 102400000000000);
 391 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" + something\n';
 392 $a = (102400000000000 + $1);
 393 $b = (102400000000000 + "$1");
 394 print "not "x($a ne $b), "ok ", $T++, qq ' - something + \$1 vs "\$1"\n';
 395 $a = ($1 - 10240000000000000);
 396 $b = ("$1" - 10240000000000000);
 397 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" - something\n';
 398 $a = (10240000000000000 - $1);
 399 $b = (10240000000000000 - "$1");
 400 print "not "x($a ne $b), "ok ", $T++, qq ' - something - \$1 vs "\$1"\n';
 401 "976562500" =~ /(\d+)/;
 402 $a = ($1 ** 2);
 403 $b = ("$1" ** 2);
 404 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" ** something\n';
 405 "32" =~ /(\d+)/;
 406 $a = (3 ** $1);
 407 $b = (3 ** "$1");
 408 print "not "x($a ne $b), "ok ", $T++, qq ' - something ** \$1 vs "\$1"\n';
 409 "97656250000000000" =~ /(\d+)/;
 410 $a = ($1 / 10);
 411 $b = ("$1" / 10);
 412 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" / something\n';
 413 "10" =~ /(\d+)/;
 414 $a = (97656250000000000 / $1);
 415 $b = (97656250000000000 / "$1");
 416 print "not "x($a ne $b), "ok ", $T++, qq ' - something / \$1 vs "\$1"\n';
 417 "97656250000000000" =~ /(\d+)/;
 418 $a = ($1 <=> 97656250000000001);
 419 $b = ("$1" <=> 97656250000000001);
 420 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" <=> something\n';
 421 $a = (97656250000000001 <=> $1);
 422 $b = (97656250000000001 <=> "$1");
 423 print "not "x($a ne $b), "ok ", $T++, qq ' - something <=> \$1 vs "\$1"\n';
 424 "97656250000000001" =~ /(\d+)/;
 425 $a = ($1 % 97656250000000002);
 426 $b = ("$1" % 97656250000000002);
 427 print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" % something\n';
 428 $a = (97656250000000000 % $1);
 429 $b = (97656250000000000 % "$1");
 430 print "not "x($a ne $b), "ok ", $T++, qq ' - something % \$1 vs "\$1"\n';
 431
 432 my $vms_no_ieee;
 433 if ($^O eq 'VMS') {
 434   eval { require Config };
 435   $vms_no_ieee = 1 unless defined($Config::Config{useieee});
 436 }
 437
 438 if ($^O eq 'vos') {
 439   print "not ok ", $T++, " # TODO VOS raises SIGFPE instead of producing infinity.\n";
 440 }
 441 elsif ($vms_no_ieee || !$Config{d_double_has_inf}) {
 442  print "ok ", $T++, " # SKIP -- the IEEE infinity model is unavailable in this configuration.\n"
 443 }
 444 elsif ($^O eq 'ultrix') {
 445   print "not ok ", $T++, " # TODO Ultrix enters deep nirvana instead of producing infinity.\n";
 446 }
 447 else {
 448   # The computation of $v should overflow and produce "infinity"
 449   # on any system whose max exponent is less than 10**1506.
 450   # The exact string used to represent infinity varies by OS,
 451   # so we don't test for it; all we care is that we don't die.
 452   #
 453   # Perl considers it to be an error if SIGFPE is raised.
 454   # Chances are the interpreter will die, since it doesn't set
 455   # up a handler for SIGFPE.  That's why this test is last; to
 456   # minimize the number of test failures.  --PG
 457
 458   my $n = 5000;
 459   my $v = 2;
 460   while (--$n)
 461   {
 462     $v *= 2;
 463   }
 464   print "ok ", $T++, " - infinity\n";
 465 }
 466
 467
 468 # [perl #120426]
 469 # small numbers shouldn't round to zero if they have extra floating digits
 470
 471 unless ($Config{d_double_style_ieee}) {
 472 for (1..8) { print "ok ", $T++, " # SKIP -- not IEEE\n" }
 473 } else {
 474 try $T++,  0.153e-305 != 0.0,              '0.153e-305';
 475 try $T++,  0.1530e-305 != 0.0,             '0.1530e-305';
 476 try $T++,  0.15300e-305 != 0.0,            '0.15300e-305';
 477 try $T++,  0.153000e-305 != 0.0,           '0.153000e-305';
 478 try $T++,  0.1530000e-305 != 0.0,          '0.1530000e-305';
 479 try $T++,  0.1530001e-305 != 0.0,          '0.1530001e-305';
 480 try $T++,  1.17549435100e-38 != 0.0,       'min single';
 481 # For flush-to-zero systems this may flush-to-zero, see PERL_SYS_FPU_INIT
 482 try $T++,  2.2250738585072014e-308 != 0.0, 'min double';
 483 }
 484
 485 # string-to-nv should equal float literals
 486 try $T++, "1.23"   + 0 ==  1.23,  '1.23';
 487 try $T++, " 1.23"  + 0 ==  1.23,  '1.23 with leading space';
 488 try $T++, "1.23 "  + 0 ==  1.23,  '1.23 with trailing space';
 489 try $T++, "+1.23"  + 0 ==  1.23,  '1.23 with unary plus';
 490 try $T++, "-1.23"  + 0 == -1.23,  '1.23 with unary minus';
 491 try $T++, "1.23e4" + 0 ==  12300, '1.23e4';
 492
 493 # trigger various attempts to negate IV_MIN
 494
 495 tryeq $T++,  0x80000000 / -0x80000000, -1, '(IV_MAX+1) / IV_MIN';
 496 tryeq $T++, -0x80000000 /  0x80000000, -1, 'IV_MIN / (IV_MAX+1)';
 497 tryeq $T++,  0x80000000 / -1, -0x80000000, '(IV_MAX+1) / -1';
 498 tryeq $T++,           0 % -0x80000000,  0, '0 % IV_MIN';
 499 tryeq $T++, -0x80000000 % -0x80000000,  0, 'IV_MIN % IV_MIN';