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