Ticket #1336: bigint.t.patch
File bigint.t.patch, 46.8 KB (added by kurahaupo, 12 years ago) |
---|
-
t/pmc/bigint.t
1 #! p erl1 #! parrot 2 2 # Copyright (C) 2001-2007, Parrot Foundation. 3 3 # $Id$ 4 4 5 use strict;6 use warnings;7 use lib qw( . lib ../lib ../../lib );8 9 use Test::More;10 use Parrot::Test;11 use Parrot::Config;12 13 5 =head1 NAME 14 6 15 7 t/pmc/bigint.t - BigInt PMC … … 24 16 25 17 =cut 26 18 27 if ( $PConfig{gmp} ) { 28 plan tests => 44; 29 } 30 else { 31 plan skip_all => "No BigInt Lib configured"; 32 } 19 .sub main :main 33 20 34 my $vers_check = <<'EOP'; 35 .sub main :main 36 .local pmc b, ar 37 .local string v 38 .local int ma, mi, pa 39 b = new ['BigInt'] 40 v = b.'version'() 41 ar = split '.', v 42 ma = ar[0] 43 mi = ar[1] 44 pa = ar[2] 45 if ma >= 4 goto ge_4 46 warn: 47 print 'GMP version ' 48 print v 49 print " is buggy with huge digit multiply - please upgrade\n" 50 end 51 ge_4: 52 if mi >= 2 goto ok 53 if mi == 0 goto warn 54 # test 4.1.x 55 if pa >= 4 goto ok 56 goto warn 57 end 58 ok: 21 .include 'test_more.pir' 22 23 plan(45) 24 check_libgmp_good() 25 26 set_and_get() 27 addition() 28 subtraction() 29 multiplication() 30 division() 31 division_by_zero() 32 negation() 33 absolute_value() 34 overflow_coercion() 35 interface() 36 boolean() 37 pi() 38 left_shift() 39 right_shift() 40 bugfixes() 41 59 42 .end 60 EOP61 43 62 if ( $PConfig{gmp} ) { 44 .include 'iglobals.pasm' 45 .include 'fp_equality.pasm' 46 .include 'errors.pasm' 63 47 64 # argh 65 my $parrot = '.' . $PConfig{slash} . 'parrot' . $PConfig{exe}; 66 my $test = 'temp_gmp_vers.pir'; 67 open my $O, '>', "$test" or die "can't open $test: $!"; 68 print $O $vers_check; 69 close $O; 70 my $warn = `$parrot $test`; 71 diag $warn if $warn; 72 unlink $test; 73 } 48 .sub check_libgmp_good 49 # check libgmp included in Parrot build 50 $P0 = getinterp 51 $P1 = $P0[.IGLOBALS_CONFIG_HASH] 74 52 75 pasm_output_is( <<'CODE', <<'OUT', "create" ); 76 new P0, ['BigInt'] 77 print "ok\n" 78 end 79 CODE 80 ok 81 OUT 53 $P2 = $P1['gmp'] 54 $I1 = isnull $P2 55 if $I1, NoLibGMP 56 say 'This Parrot uses GMP' 82 57 83 pasm_output_is( <<'CODE', <<'OUT', "set/get int" ); 84 new P0, ['BigInt'] 85 set P0, 999999 86 set I1, P0 87 print I1 88 print "\n" 89 get_repr S0, P0 90 print S0 91 print "\n" 92 end 93 CODE 94 999999 95 999999L 96 OUT 58 # check version is >= 4.1.4 59 $P0 = new ['BigInt'] 60 $S3 = $P0.'version'() 61 $P1 = split '.', $S3 62 $S0 = $P1[0] 63 $I0 = $S0 64 gt $I0, 4, Config2 65 lt $I0, 4, OldLibGMP 66 $S1 = $P1[1] 67 $I1 = $S1 68 gt $I1, 1, Config2 69 lt $I1, 1, OldLibGMP 70 $S2 = $P1[2] 71 $I2 = $S2 72 lt $I2, 4, OldLibGMP 97 73 98 pasm_output_is( <<"CODE", <<'OUT', "set int, get double" ); 99 .include 'fp_equality.pasm' 100 new P0, ['BigInt'] 101 set P0, 999999 102 set N1, P0 103 .fp_eq_pasm(N1, 999999.0, OK1) 104 print "not " 105 OK1: print "ok 1\\n" 74 Config2: 75 print 'Suitable GMP version [' 76 print $S3 77 say '] available' 78 goto ret 106 79 107 set P0, -999999 108 set N1, P0 109 .fp_eq_pasm(N1, -999999.0, OK2) 110 print "not " 111 OK2: print "ok 2\\n" 80 NoLibGMP: 81 ok(1, 'No BigInt Lib configured') 82 skip(44) 83 exit 0 112 84 113 set P0, 2147483646 114 set N1, P0 115 .fp_eq_pasm(N1, 2.147483646e9, OK3) 116 print "not " 117 OK3: print "ok 3\\n" 85 OldLibGMP: 86 print 'Buggy GMP version [' 87 print $S3 88 say '] with huge digit multiply - please upgrade' 89 ok(0) 90 skip(44) 91 exit 1 118 92 119 set P0, -2147483646 120 set N1, P0 121 .fp_eq_pasm(N1, -2.147483646e9, OK4) 122 print "not " 123 OK4: print "ok 4\\n" 124 end 125 CODE 126 ok 1 127 ok 2 128 ok 3 129 ok 4 130 OUT 93 ret: 94 .end 131 95 132 pasm_output_is( <<'CODE', <<'OUT', "set double, get str" ); 133 new P0, ['BigInt'] 134 set P0, 1.23e12 135 print P0 136 print "\n" 137 end 138 CODE 139 1230000000000 140 OUT 96 .sub set_and_get 97 $I1 = 1 98 $P0 = new ['BigInt'] 99 $I0 = 999999 100 $P0 = $I0 101 $I2 = $P0 102 eq $I0, $I2, OK1 103 $I1 = 0 104 say 'set_int/get_int 999999 wrong' 105 OK1: 141 106 142 pasm_output_is( <<'CODE', <<'OUT', "set str, get str" ); 143 new P0, ['BigInt']144 set P0, "1230000000000"145 printP0146 print "\n"147 end148 CODE 149 1230000000000 150 O UT107 $P0 = new ['BigInt'] 108 $I0 = 999999 109 $P0 = $I0 110 $S0 = get_repr $P0 111 $I2 = $S0 112 eq $I0, $I2, OK2 113 $I1 = 0 114 say 'set_int/get_str 999999 wrong' 115 OK2: 151 116 152 pasm_output_is( <<'CODE', <<'OUT', "add" ); 153 new P0, ['BigInt'] 154 set P0, 999999 155 new P1, ['BigInt'] 156 set P1, 1000000 157 new P2, ['BigInt'] 158 add P2, P0, P1 159 set S0, P2 160 print S0 161 print "\n" 162 set P0, "12345678987654321" 163 set P1, "10000000000000000" 164 add P2, P1, P0 165 set S0, P2 166 print S0 167 print "\n" 168 end 169 CODE 170 1999999 171 22345678987654321 172 OUT 117 $P0 = new ['BigInt'] 118 $P0 = 999999 119 $N1 = $P0 120 .fp_eq($N1, 999999.0, OK3) 121 $I1 = 0 122 say 'set_int/get_num 999999 wrong' 123 OK3: 173 124 174 pasm_output_is( <<'CODE', <<'OUT', "add_int" ); 175 new P0, ['BigInt'] 176 set P0, 999999 177 new P2, ['BigInt'] 178 add P2, P0, 1000000 179 set S0, P2 180 print S0 181 print "\n" 182 set P0, "100000000000000000000" 183 add P2, P0, 1000000 184 set S0, P2 185 print S0 186 print "\n" 187 end 188 CODE 189 1999999 190 100000000000001000000 191 OUT 125 $P0 = -999999 126 $N1 = $P0 127 .fp_eq($N1, -999999.0, OK4) 128 $I1 = 0 129 say 'set_int/get_num -999999 wrong' 130 OK4: 192 131 193 pasm_output_is( <<'CODE', <<'OUTPUT', "sub bigint" ); 194 new P0, ['BigInt'] 195 set P0, 12345678 196 new P1, ['BigInt'] 197 set P1, 5678 198 new P2, ['BigInt'] 199 sub P2, P0, P1 200 set I0, P2 201 eq I0, 12340000, OK1 202 print "not " 203 OK1: print "ok 1\n" 204 set P0, "123456789012345678" 205 sub P2, P0, P1 206 new P3, ['BigInt'] 207 set P3, "123456789012340000" 208 eq P2, P3, OK2 209 print "not " 210 OK2: print "ok 2\n" 211 set P1, "223456789012345678" 212 sub P2, P0, P1 213 set P3, "-100000000000000000" 214 eq P2, P3, OK3 215 print "not " 216 OK3: print "ok 3\n" 217 end 218 CODE 219 ok 1 220 ok 2 221 ok 3 222 OUTPUT 132 $P0 = 2147483646 133 $N1 = $P0 134 .fp_eq($N1, 2.147483646e9, OK5) 135 $I1 = 0 136 say 'set_int/get_num 2^31-1 wrong' 137 OK5: 223 138 224 pasm_output_is( <<'CODE', <<'OUTPUT', "sub native int" ); 225 new P0, ['BigInt'] 226 set P0, 12345678 227 new P2, ['BigInt'] 228 sub P2, P0, 5678 229 set I0, P2 230 eq I0, 12340000, OK1 231 print "not " 232 OK1: print "ok 1\n" 233 set P0, "123456789012345678" 234 sub P2, P0, 5678 235 new P3, ['BigInt'] 236 set P3, "123456789012340000" 237 eq P2, P3, OK2 238 print "not " 239 OK2: print "ok 2\n" 240 end 241 CODE 242 ok 1 243 ok 2 244 OUTPUT 139 $P0 = -2147483646 140 $N1 = $P0 141 .fp_eq($N1, -2.147483646e9, OK6) 142 $I1 = 0 143 say 'set_int/get_num 2-2^31 wrong' 144 OK6: 245 145 246 pasm_output_is( <<'CODE', <<'OUTPUT', "sub other int" ); 247 new P0, ['BigInt'] 248 set P0, 12345678 249 new P1, ['Integer'] 250 set P1, 5678 251 new P2, ['BigInt'] 252 sub P2, P0, P1 253 set I0, P2 254 eq I0, 12340000, OK1 255 print "not " 256 OK1: print "ok 1\n" 257 set P0, "123456789012345678" 258 sub P2, P0, P1 259 new P3, ['BigInt'] 260 set P3, "123456789012340000" 261 eq P2, P3, OK2 262 print "not " 263 OK2: print "ok 2\n" 264 set P0, 9876543 265 new P4, ['Integer'] 266 set P4, 44 267 sub P2, P0, P4 268 set I0, P2 269 eq I0, 9876499, OK3 270 print "not " 271 OK3: print "ok 3\n" 272 set P0, "9876543219876543" 273 sub P2, P0, P4 274 set P3, "9876543219876499" 275 eq P3, P2, OK4 276 print "not " 277 OK4: print "ok 4\n" 278 end 279 CODE 280 ok 1 281 ok 2 282 ok 3 283 ok 4 284 OUTPUT 146 $P0 = new ['BigInt'] 147 $P0 = 1.23e12 148 $S0 = $P0 149 eq $S0, '1230000000000', OK7 150 $I1 = 0 151 say 'set_num/get_str 1230000000000' 152 OK7: 285 153 286 pasm_output_is( <<'CODE', <<'OUT', "mul" ); 287 new P0, ['BigInt'] 288 set P0, 999999 289 new P1, ['BigInt'] 290 set P1, 1000000 291 new P2, ['BigInt'] 292 mul P2, P0, P1 293 set S0, P2 294 print S0 295 print "\n" 296 end 297 CODE 298 999999000000 299 OUT 154 $P0 = new ['BigInt'] 155 $P0 = '1230000000000' 156 $S0 = $P0 157 eq $S0, '1230000000000', OK8 158 $I1 = 0 159 say 'set_str/get_str 1230000000000' 300 160 301 pasm_output_is( <<'CODE', <<'OUT', "mul_int" ); 302 new P0, ['BigInt'] 303 set P0, 999999 304 new P2, ['BigInt'] 305 mul P2, P0, 1000000 306 print P2 307 print "\n" 308 end 309 CODE 310 999999000000 311 OUT 161 OK8: 162 ok($I1, 'set and get combinations') 163 .end 312 164 313 pasm_output_is( <<'CODE', <<'OUT', "div bigint" ); 314 new P0, ['BigInt'] 315 set P0, "100000000000000000000" 316 new P1, ['BigInt'] 317 set P1, "100000000000000000000" 318 new P2, ['BigInt'] 319 div P2, P0, P1 320 set I0, P2 321 eq I0, 1, OK1 322 print "not " 323 OK1: print "ok 1\n" 165 .sub addition 166 $I1 = 1 167 $P0 = new ['BigInt'] 168 $P0 = 999999 169 $P1 = new ['BigInt'] 170 $P1 = 1000000 171 $P2 = new ['BigInt'] 172 $P2 = add $P0, $P1 173 $S0 = $P2 174 eq $S0, '1999999', OK1 175 $I1 = 0 176 say 'add 999999+1000000 wrong' 177 OK1: 324 178 325 new P3, ['BigInt'] 326 set P3, "10000000000000" 327 set P1, 10000000 328 div P2, P0, P1 329 eq P2, P3, OK2 330 print "not " 331 OK2: print "ok 2\n" 179 $P0 = '12345678987654321' 180 $P1 = '10000000000000000' 181 $P2 = add $P1, $P0 182 $S0 = $P2 183 eq $S0,'22345678987654321',OK2 184 $I1 = 0 185 say 'add 12345678987654321+10000000000000000 wrong' 186 OK2: 187 ok($I1, 'add(bigint,bigint)') 332 188 333 set P1, 10 334 set P3, "10000000000000000000" 335 div P2, P0, P1 336 eq P2, P3, OK3 337 print "not " 338 OK3: print "ok 3\n" 189 $I1 = 1 190 $P0 = 999999 191 $P2 = add $P0, 1000000 192 $S0 = $P2 193 eq $S0,'1999999',OK3 194 $I1 = 0 195 say 'add 999999+1000000 wrong' 196 OK3: 339 197 340 set P1, -1 341 set P3, "-100000000000000000000" 342 div P2, P0, P1 343 eq P2, P3, OK4 344 print "not " 345 OK4: print "ok 4\n" 346 end 347 CODE 348 ok 1 349 ok 2 350 ok 3 351 ok 4 352 OUT 198 $P0 = '100000000000000000000' 199 $P2 = add $P0, 1000000 200 $S0 = $P2 201 eq $S0,'100000000000001000000',OK4 202 $I1 = 0 203 say 'add 100000000000000000000+1000000 wrong' 204 OK4: 205 ok($I1, 'add(bigint,nativeint)') 353 206 354 pasm_output_is( <<'CODE', <<'OUT', "div native int" ); 355 new P0, ['BigInt'] 356 set P0, "100000000000000000000" 357 new P1, ['BigInt'] 358 div P1, P0, 10 359 new P2, ['BigInt'] 360 set P2, "10000000000000000000" 361 eq P1, P2, OK1 362 print "not " 363 OK1: print "ok 1\n" 207 .end 364 208 365 set P0, "100000000000000" 366 div P1, P0, 10000000 367 set P2, 10000000 368 eq P1, P2, OK2 369 print "not " 370 OK2: print "ok 2\n" 371 end 372 CODE 373 ok 1 374 ok 2 375 OUT 209 .sub subtraction 210 $I1 = 1 211 $P0 = new ['BigInt'] 212 $P0 = 12345678 213 $P1 = new ['BigInt'] 214 $P1 = 5678 215 $P2 = new ['BigInt'] 216 $P2 = sub $P0, $P1 217 $I0 = $P2 218 eq $I0, 12340000, OK1 219 $I1 = 0 220 say 'sub 12345678-5678 wrong' 221 OK1: 376 222 377 pasm_output_is( <<'CODE', <<'OUT', "div other int" ); 378 new P0, ['BigInt'] 379 set P0, "100000000000000000000" 380 new P1, ['BigInt'] 381 new P3, ['Integer'] 382 set P3, 10 383 div P1, P0, P3 384 new P2, ['BigInt'] 385 set P2, "10000000000000000000" 386 eq P1, P2, OK1 387 print "not " 388 OK1: print "ok 1\n" 223 $P0 = '123456789012345678' 224 $P2 = sub $P0, $P1 225 $P3 = new ['BigInt'] 226 $P3 = '123456789012340000' 227 eq $P2, $P3, OK2 228 $I1 = 0 229 say 'sub 123456789012345678-5678 wrong' 230 OK2: 389 231 390 set P0, "100000000000000" 391 new P4, ['Integer'] 392 set P4, 10000000 393 div P1, P0, P4 394 set P2, 10000000 395 eq P1, P2, OK2 396 print "not " 397 OK2: print "ok 2\n" 398 end 399 CODE 400 ok 1 401 ok 2 402 OUT 232 $P1 = '223456789012345678' 233 $P2 = sub $P0, $P1 234 $P3 = '-100000000000000000' 235 eq $P2, $P3, OK3 236 $I1 = 0 237 say 'sub 123456789012345678-(-100000000000000000) wrong' 238 OK3: 239 ok($I1, 'sub(bigint,bigint)') 240 $I1 = 1 403 241 404 for my $op ( "/", "%" ) { 405 for my $type ( "BigInt", "Integer" ) { 406 pir_output_is( <<"CODE", <<OUTPUT, "bigint $op by zero $type" ); 407 .sub _main :main 408 \$P0 = new ['BigInt'] 409 set \$P0, "1000000000000000000000" 410 \$P1 = new ['BigInt'] 411 ## divide by a zero $type 412 \$P2 = new ['$type'] 413 set \$P2, 0 414 push_eh OK 415 \$P1 = \$P0 $op \$P2 416 print "fail\\n" 417 pop_eh 418 OK: 419 get_results '0', \$P0 420 \$S0 = \$P0 421 print "ok\\n" 422 print \$S0 423 print "\\n" 242 $P0 = 12345678 243 $P2 = sub $P0, 5678 244 $I0 = $P2 245 eq $I0, 12340000, OK4 246 $I1 = 0 247 say 'sub 12345678-5678 wrong' 248 OK4: 249 250 $P0 = '123456789012345678' 251 $P2 = sub $P0, 5678 252 $P3 = new ['BigInt'] 253 $P3 = '123456789012340000' 254 eq $P2, $P3, OK5 255 $I1 = 0 256 say 'sub 123456789012345678-5678 wrong' 257 OK5: 258 259 $P0 = new ['BigInt'] 260 $P0 = 12345678 261 $P1 = new ['Integer'] 262 $P1 = 5678 263 $P2 = new ['BigInt'] 264 $P2 = sub $P0, $P1 265 $I0 = $P2 266 eq $I0, 12340000, OK6 267 $I1 = 0 268 say 'sub 12345678-5678 wrong' 269 OK6: 270 271 $P0 = '123456789012345678' 272 $P2 = sub $P0, $P1 273 $P3 = new ['BigInt'] 274 $P3 = '123456789012340000' 275 eq $P2, $P3, OK7 276 $I1 = 0 277 say 'sub 123456789012345678-5678 wrong' 278 OK7: 279 280 $P0 = 9876543 281 $P4 = new ['Integer'] 282 $P4 = 44 283 $P2 = sub $P0, $P4 284 $I0 = $P2 285 eq $I0, 9876499, OK8 286 $I1 = 0 287 say 'sub 9876543-44 wrong' 288 OK8: 289 290 $P0 = '9876543219876543' 291 $P2 = sub $P0, $P4 292 $P3 = '9876543219876499' 293 eq $P3, $P2, OK9 294 $I1 = 0 295 say 'sub 9876543219876543-44 wrong' 296 OK9: 297 ok($I1, 'sub(bigint,integer)') 424 298 .end 425 CODE426 ok427 Divide by zero428 OUTPUT429 }430 }431 299 432 { 433 my ( $a, $b, $c, $d, $e ); 434 if ( $PConfig{intvalsize} == 8 ) { 435 $a = '9223372036854775806'; # 2**63-2 436 $b = '1'; 437 $c = '9223372036854775807'; # still Integer 438 $d = '9223372036854775808'; # no more Integer 439 $e = '9223372036854775809'; # still no more Integer 440 } 441 elsif ( $PConfig{intvalsize} == 4 ) { 442 $a = '2147483646'; # 2**31-2 443 $b = '1'; 444 $c = '2147483647'; # still Integer 445 $d = '2147483648'; # no more PerlInt 446 $e = '2147483649'; # still no more PerlInt 447 } 448 else { 449 die "\$PConfig{intvalsize} == $PConfig{intvalsize}?\n"; 450 } 300 .sub multiplication 301 $P0 = new ['BigInt'] 302 $P0 = 999999 303 $P1 = new ['BigInt'] 304 $P1 = 1000000 305 $P2 = new ['BigInt'] 306 $P2 = mul $P0, $P1 307 $S0 = $P2 308 is($S0, '999999000000', 'mul(bigint,bigint)') 451 309 452 pasm_output_is( <<CODE, <<OUT, "add overflow Integer" ); 453 new P0, ['Integer'] 454 set P0, $a 455 new P1, ['Integer'] 456 set P1, $b 457 new P2, ['Integer'] 458 new P3, ['BigInt'] 459 set I3, 3 460 lp: 461 add P2, P0, P1 462 set S0, P2 463 print S0 464 print " " 465 typeof S1, P2 466 print S1 467 print "\\n" 468 add P1, $b 469 dec I3 470 if I3, lp 471 print "ok\\n" 472 ex: 473 end 474 CODE 475 $c Integer 476 $d BigInt 477 $e BigInt 478 ok 479 OUT 310 $P0 = new ['BigInt'] 311 $P0 = 999999 312 $P2 = new ['BigInt'] 313 $P2 = mul $P0, 1000000 314 is($P2, '999999000000', 'mul(bigint,nativeint)') 315 .end 480 316 481 pasm_output_is( <<CODE, <<OUT, "add overflow Integer" ); 482 new P0, ['Integer'] 483 set P0, $a 484 new P1, ['Integer'] 485 set P1, $b 486 new P2, ['Integer'] 487 new P3, ['BigInt'] 488 set I3, 3 489 lp: 490 add P2, P0, P1 491 set S0, P2 492 print S0 493 print " " 494 typeof S1, P2 495 print S1 496 print "\\n" 497 add P1, $b 498 dec I3 499 if I3, lp 500 print "ok\\n" 501 ex: 502 end 503 CODE 504 $c Integer 505 $d BigInt 506 $e BigInt 507 ok 508 OUT 509 } 317 .sub division 318 $I1 = 1 319 $P0 = new ['BigInt'] 320 $P0 = '100000000000000000000' 321 $P1 = new ['BigInt'] 322 $P1 = '100000000000000000000' 323 $P2 = new ['BigInt'] 324 $P2 = div $P0, $P1 325 $I0 = $P2 326 eq $I0, 1, OK1 327 $I1 = 0 328 say 'div 100000000000000000000/100000000000000000000 wrong' 329 OK1: 510 330 511 pasm_output_is( <<'CODE', <<'OUT', "abs" ); 512 new P0, ['BigInt'] 513 set P0, "-1230000000000" 514 new P1, ['Undef'] 515 abs P1, P0 516 print P1 517 print "\n" 518 print P0 519 print "\n" 520 abs P0 521 print P0 522 print "\n" 523 end 524 CODE 525 1230000000000 526 -1230000000000 527 1230000000000 528 OUT 331 $P3 = new ['BigInt'] 332 $P3 = '10000000000000' 333 $P1 = 10000000 334 $P2 = div $P0, $P1 335 eq $P2, $P3, OK2 336 $I1 = 0 337 say 'div 100000000000000000000/10000000 wrong' 338 OK2: 529 339 530 pir_output_is( << 'CODE', << 'OUTPUT', "check whether interface is done" ); 340 $P1 = 10 341 $P3 = '10000000000000000000' 342 $P2 = div $P0, $P1 343 eq $P2, $P3, OK3 344 $I1 = 0 345 say 'div 100000000000000000000/10 wrong' 346 OK3: 531 347 532 .sub _main 533 .local pmc pmc1 534 pmc1 = new ['BigInt'] 535 .local int bool1 536 does bool1, pmc1, "scalar" 537 print bool1 538 print "\n" 539 does bool1, pmc1, "no_interface" 540 print bool1 541 print "\n" 542 end 348 $P1 = -1 349 $P3 = '-100000000000000000000' 350 $P2 = div $P0, $P1 351 eq $P2, $P3, OK4 352 $I1 = 0 353 say 'div 100000000000000000000/(-1) wrong' 354 OK4: 355 ok($I1, 'div(bigint,bigint)') 356 $I1 = 1 357 358 $P0 = new ['BigInt'] 359 $P0 = '100000000000000000000' 360 $P1 = new ['BigInt'] 361 $P1 = div $P0, 10 362 $P2 = new ['BigInt'] 363 $P2 = '10000000000000000000' 364 eq $P1, $P2, OK5 365 $I1 = 0 366 say 'div 100000000000000000000/10 wrong' 367 OK5: 368 369 $P0 = '100000000000000' 370 $P1 = div $P0, 10000000 371 $P2 = 10000000 372 eq $P1, $P2, OK6 373 $I1 = 0 374 say 'div 100000000000000/10000000 wrong' 375 OK6: 376 ok($I1, 'div(bigint,nativeint)') 377 $I1 = 1 378 379 $P0 = new ['BigInt'] 380 $P0 = '100000000000000000000' 381 $P1 = new ['BigInt'] 382 $P3 = new ['Integer'] 383 $P3 = 10 384 $P1 = div $P0, $P3 385 $P2 = new ['BigInt'] 386 $P2 = '10000000000000000000' 387 eq $P1, $P2, OK7 388 $I1 = 0 389 say 'div 100000000000000000000/10 wrong' 390 OK7: 391 392 $P0 = '100000000000000' 393 $P4 = new ['Integer'] 394 $P4 = 10000000 395 $P1 = div $P0, $P4 396 $P2 = 10000000 397 eq $P1, $P2, OK8 398 $I1 = 0 399 say 'div 100000000000000/10000000 wrong' 400 OK8: 401 ok($I1, 'div(bigint,integer)') 402 543 403 .end 544 CODE545 1546 0547 OUTPUT548 404 549 pasm_output_is( <<"CODE", <<'OUTPUT', "Truth" ); 550 new P0, ['BigInt'] 551 set P0, "123456789123456789" 552 if P0, OK1 553 print "not " 554 OK1: print "ok 1\\n" 555 set P0, 0 556 unless P0, OK2 557 print "not " 558 OK2: print "ok 2\\n" 559 end 560 CODE 561 ok 1 562 ok 2 563 OUTPUT 405 .sub division_by_zero 406 $I1 = 1 407 $P0 = new ['BigInt'] 408 $P0 = '1000000000000000000000' 409 $P1 = new ['BigInt'] 410 ## divide by a zero BigInt 411 $P2 = new ['BigInt'] 412 $P2 = 0 413 push_eh E1 414 $P1 = div $P0, $P2 415 $I1 = 0 416 say 'Failed to throw exception' 417 E1: 418 pop_eh 419 get_results '0', $P0 420 $S0 = $P0 421 eq $S0, 'Divide by zero', OK1 422 $I1 = 0 423 print $S0 424 say ' is wrong exception type' 425 OK1: 426 ok($I1, 'div(bigint,bigint 0) throws "Divide by zero" exception') 427 $I1 = 1 564 428 565 pasm_output_is( <<"CODE", <<'OUTPUT', "neg" ); 566 new P0, ['BigInt'] 567 new P1, ['BigInt'] 568 set P0, "123456789123456789" 569 neg P0 570 set P1, "-123456789123456789" 571 eq P0, P1, OK1 572 print "not " 573 OK1: print "ok 1\\n" 574 end 575 CODE 576 ok 1 577 OUTPUT 429 $P0 = new ['BigInt'] 430 $P0 = '1000000000000000000000' 431 $P1 = new ['BigInt'] 432 ## modulus by a zero BigInt 433 $P2 = new ['BigInt'] 434 $P2 = 0 435 push_eh E2 436 $P1 = mod $P0, $P2 437 $I1 = 0 438 say 'Failed to throw exception' 439 E2: 440 pop_eh 441 get_results '0', $P0 442 $S0 = $P0 443 eq $S0, 'Divide by zero', OK2 444 $I1 = 0 445 print $S0 446 say ' is wrong exception type' 447 OK2: 448 ok($I1, 'mod(bigint,bigint 0) throws "Divide by zero" exception') 449 $I1 = 1 578 450 579 pir_output_is( <<'CODE', <<'OUTPUT', "pi() generator" ); 580 .sub PI 581 .local pmc k, a, b, a1, b1 582 k = new ['Integer'] 583 k = 2 584 a = new ['Integer'] 585 a = 4 586 b = new ['Integer'] 587 b = 1 588 a1 = new ['Integer'] 589 a1 = 12 590 b1 = new ['Integer'] 591 b1 = 4 592 forever: 593 .local pmc p, q 594 p = mul k, k 595 q = mul k, 2 596 inc q 597 inc k 598 .local pmc ta, tb, ta1, tb1 599 ta = clone a1 600 tb = clone b1 601 $P0 = mul p, a 602 $P1 = mul q, a1 603 ta1 = add $P0, $P1 604 $P2 = mul p, b 605 $P3 = mul q, b1 606 tb1 = add $P2, $P3 607 a = ta 608 b = tb 609 a1 = ta1 610 b1 = tb1 611 .local pmc d, d1 612 d = fdiv a, b 613 d1 = fdiv a1, b1 614 yield_loop: 615 unless d == d1 goto end_yield 616 .yield(d) 617 $P4 = mod a, b 618 a = mul $P4, 10 619 $P5 = mod a1, b1 620 a1 = mul $P5, 10 621 d = fdiv a, b 622 d1 = fdiv a1, b1 623 goto yield_loop 624 end_yield: 625 goto forever 451 $P0 = new ['BigInt'] 452 $P0 = '1000000000000000000000' 453 $P1 = new ['BigInt'] 454 ## divide by a zero Integer 455 $P2 = new ['Integer'] 456 $P2 = 0 457 push_eh E3 458 $P1 = div $P0, $P2 459 $I1 = 0 460 say 'Failed to throw exception' 461 E3: 462 pop_eh 463 get_results '0', $P0 464 $S0 = $P0 465 eq $S0, 'Divide by zero', OK3 466 $I1 = 0 467 print $S0 468 say ' is wrong exception type' 469 OK3: 470 ok($I1, 'div(bigint,integer 0) throws "Divide by zero" exception') 471 $I1 = 1 472 473 $P0 = new ['BigInt'] 474 $P0 = '1000000000000000000000' 475 $P1 = new ['BigInt'] 476 ## modulus by a zero Integer 477 $P2 = new ['Integer'] 478 $P2 = 0 479 push_eh E4 480 $P1 = mod $P0, $P2 481 $I1 = 0 482 say 'Failed to throw exception' 483 E4: 484 pop_eh 485 get_results '0', $S0 486 eq $S0, 'Divide by zero', OK4 487 $I1 = 0 488 print $S0 489 say ' is wrong exception type' 490 OK4: 491 ok($I1, 'mod(bigint,integer 0) throws "Divide by zero" exception') 492 626 493 .end 627 494 628 .sub main :main 629 .local int i 630 .local pmc d 631 null i 632 loop: 633 d = PI() 634 print d 635 inc i 636 $I0 = i % 50 637 if $I0 goto no_nl 638 print "\n" 639 no_nl: 640 if i < 1000 goto loop 641 print "\n" 495 .sub negation 496 $I1 = 1 497 $P0 = new ['BigInt'] 498 $P1 = new ['BigInt'] 499 $P0 = '123456789123456789' 500 neg $P0 501 $P1 = '-123456789123456789' 502 eq $P0, $P1, OK1 503 $I1 = 0 504 OK1: 505 $P0 = '-123456789123456789' 506 neg $P0 507 $P1 = '123456789123456789' 508 eq $P0, $P1, OK2 509 $I1 = 0 510 OK2: 511 ok($I1, 'negation') 642 512 .end 643 513 644 =begin python 514 .sub absolute_value 515 $P0 = new ['BigInt'] 516 $P0 = '-1230000000000000000000' 517 $P1 = new ['Undef'] 518 $P1 = abs $P0 519 $S0 = $P1 520 is($S0,'1230000000000000000000','abs negates negative number') 521 $S0 = $P0 522 is($S0,'-1230000000000000000000','... and original unchanged with 2-arg form') 523 $P1 = abs $P1 524 $S0 = $P1 525 is($S0,'1230000000000000000000','... does not change to positive number') 526 $S0 = $P1 527 abs $P0 528 $S0 = $P0 529 is($S0,'1230000000000000000000','... and in-place works too') 530 .end 645 531 646 class PI(object): 647 def __iter__(self):648 k, a, b, a1, b1 = 2, 4, 1, 12, 4649 while 1:650 p, q, k = k*k, 2*k+1, k+1651 a, b, a1, b1 = a1, b1, p*a+q*a1, p*b+q*b1652 d, d1 = a//b, a1//b1653 while d == d1:654 yield d655 a, a1 = 10*(a%b), 10*(a1%b1)656 d, d1 = a//b, a1//b1532 .sub overflow_coercion 533 # check libgmp included in Parrot build 534 $P0 = getinterp 535 $P4 = $P0[.IGLOBALS_CONFIG_HASH] 536 $I0 = $P4['intvalsize'] 537 eq $I0, 8, sz8 538 eq $I0, 4, sz4 539 print 'Cannot cope with sizeof(INTVAL) == ' 540 say $I0 541 skip(43) 542 exit 1 657 543 658 pi = iter(PI()) 659 ds = "" 660 for i in xrange(1, 1001): 661 d = pi.next() 662 ds += str(d) 663 im = i % 50 664 if im == 0: 665 print ds 666 ds = "" 544 sz8: 545 $I3 = 0x100000000 # sqrt(2*(MinInt+1)) 546 $I4 = 9223372036854775806 # MaxInt-1 == 2**63-2 547 $I5 = 9223372036854775807 # MaxInt 548 $S5 = '9223372036854775807' # MaxInt 549 $S6 = '9223372036854775808' # MaxInt+1 550 $S7 = '9223372036854775809' # MaxInt+2 551 $I8 = -9223372036854775807 # MinInt+1 == 1-2**63 552 $I9 = -9223372036854775808 # MinInt 553 $S9 = '-9223372036854775808' # MinInt 554 $S10 = '-9223372036854775809' # MinInt-1 555 $S11 = '-9223372036854775810' # MinInt-2 556 goto esz 667 557 668 print ds 558 sz4: 559 $I3 = 0x10000 # sqrt(2*(MinInt+1)) 560 $I4 = 2147483646 # MaxInt-1 == 2**31-2 561 $I5 = 2147483647 # MaxInt 562 $S5 = '2147483647' # MaxInt 563 $S6 = '2147483648' # MaxInt+1 564 $S7 = '2147483649' # MaxInt+2 565 $I8 = -2147483647 # MinInt+1 == 1-2**31 566 $I9 = -2147483648 # MinInt 567 $S9 = '-2147483648' # MinInt 568 $S10 = '-2147483649' # MinInt-1 569 $S11 = '-2147483650' # MinInt-2 570 goto esz 669 571 670 =end python 572 esz: 573 print 'Using ' 574 $I0 = mul $I0, 8 575 print $I0 576 print '-bit Integers [' 577 print $I9 578 print '...' 579 print $I5 580 say ']' 671 581 672 =cut 582 # Checking upper bound by incremental increase 583 $I1 = 1 584 $P0 = new ['Integer'] 585 $P0 = $I4 # MaxInt-1 586 $P1 = new ['Integer'] 587 $P1 = 1 588 $P0 = add $P0, $P1 589 $S0 = typeof $P0 590 eq $S0, 'Integer', k0 591 $I1 = 0 592 say "typeof != 'Integer'" 593 k0: 594 $S0 = $P0 595 eq $S0, $S5, k1 # MaxInt 596 $I1 = 0 597 say 'value != MaxInt' 598 k1: 599 $P0 = add $P0, $P1 600 $S0 = typeof $P0 601 eq $S0, 'BigInt', k2 602 $I1 = 0 603 say "typeof != 'BigInt'" 604 k2: 605 $S0 = $P0 606 eq $S0, $S6, k3 # MaxInt+1 607 $I1 = 0 608 say 'value != MaxInt+1' 609 k3: 610 $P0 = add $P0, $P1 611 $S0 = typeof $P0 612 eq $S0, 'BigInt', k4 613 $I1 = 0 614 say "typeof != 'BigInt'" 615 k4: 616 $S0 = $P0 617 eq $S0, $S7, k5 # MaxInt+2 618 $I1 = 0 619 say 'value != MaxInt+2' 620 k5: 673 621 674 CODE 622 # Checking upper bound by increased steps 623 $P0 = new ['Integer'] 624 $P0 = $I4 # MaxInt-1 625 $P2 = new ['Integer'] 626 $P2 = add $P0, $P1 627 $S0 = typeof $P2 628 eq $S0, 'Integer', k6 629 $I1 = 0 630 say "typeof != 'Integer'" 631 k6: 632 $S0 = $P2 633 eq $S0, $S5, k7 # MaxInt 634 $I1 = 0 635 say 'value != MaxInt' 636 k7: 637 inc $P1 638 $P2 = new ['Integer'] 639 $P2 = add $P0, $P1 640 $S0 = typeof $P2 641 eq $S0, 'BigInt', k8 642 $I1 = 0 643 say "typeof != 'BigInt'" 644 k8: 645 $S0 = $P2 646 eq $S0, $S6, k9 # MaxInt+1 647 $I1 = 0 648 say 'value != MaxInt+1' 649 k9: 650 add $P1, 1 651 $P2 = new ['Integer'] 652 $P2 = add $P0, $P1 653 $S0 = typeof $P2 654 eq $S0, 'BigInt', k10 655 $I1 = 0 656 say "typeof != 'BigInt'" 657 k10: 658 $S0 = $P2 659 eq $S0, $S7, k11 # MaxInt+2 660 $I1 = 0 661 say 'value != MaxInt+2' 662 k11: 663 ok($I1, 'integer addition converts MaxInt+1 to BigInt') 664 665 # Checking lower bound 666 $I1 = 6 667 $P0 = new ['Integer'] 668 $P0 = $I8 669 $P1 = -1 670 $P2 = new ['Integer'] 671 $P2 = add $P0, $P1 672 $S0 = typeof $P2 673 ne $S0, 'Integer', k12 674 dec $I1 675 k12: 676 $S0 = $P2 677 ne $S0, $S9, k13 678 dec $I1 679 k13: 680 dec $P1 681 $P2 = new ['Integer'] 682 $P2 = add $P0, $P1 683 $S0 = typeof $P2 684 ne $S0, 'BigInt', k14 685 dec $I1 686 k14: 687 $S0 = $P2 688 ne $S0, $S10, k15 689 dec $I1 690 k15: 691 sub $P1, 1 692 $P2 = new ['Integer'] 693 $P2 = add $P0, $P1 694 $S0 = typeof $P2 695 ne $S0, 'BigInt', k16 696 dec $I1 697 k16: 698 $S0 = $P2 699 ne $S0, $S11, k17 700 dec $I1 701 k17: 702 is($I1, 0, 'integer addition converts MinInt+(-1) to BigInt') 703 704 $I1 = 6 705 $P0 = new ['Integer'] 706 $P0 = $I4 707 $P1 = -1 708 $P2 = new ['Integer'] 709 $P2 = sub $P0, $P1 710 $S0 = typeof $P2 711 ne $S0, 'Integer', k18 712 dec $I1 713 k18: 714 $S0 = $P2 715 ne $S0, $S5, k19 716 dec $I1 717 k19: 718 dec $P1 719 $P2 = new ['Integer'] 720 $P2 = sub $P0, $P1 721 $S0 = typeof $P2 722 ne $S0, 'BigInt', k20 723 dec $I1 724 k20: 725 $S0 = $P2 726 ne $S0, $S6, k21 727 dec $I1 728 k21: 729 sub $P1, 1 730 $P2 = new ['Integer'] 731 $P2 = sub $P0, $P1 732 $S0 = typeof $P2 733 ne $S0, 'BigInt', k22 734 dec $I1 735 k22: 736 $S0 = $P2 737 ne $S0, $S7, k23 738 dec $I1 739 k23: 740 is($I1, 0, 'integer subtraction converts MaxInt-(-1) to BigInt') 741 742 $I1 = 0 743 $P0 = new ['Integer'] 744 $P0 = $I8 # MinInt 745 dec $P0 746 neg $P0 747 $S0 = typeof $P0 748 ne $S0, 'BigInt', k24 749 inc $I1 750 k24: 751 $S0 = $P0 752 ne $S0, $S6, k25 753 inc $I1 754 k25: 755 todo($I1, 'integer negation of MinInt converts MaxInt+1 to BigInt') 756 757 $I1 = 0 758 $P0 = new ['Integer'] 759 $P0 = $I8 # MinInt 760 dec $P0 761 abs $P0 762 $S0 = typeof $P0 763 ne $S0, 'BigInt', k26 764 inc $I1 765 k26: 766 $S0 = $P0 767 ne $S0, $S6, k27 768 inc $I1 769 k27: 770 todo($I1, 'integer absolute-value of MinInt converts MaxInt+1 to BigInt') 771 772 $P0 = new ['Integer'] 773 $P0 = $I3 774 $P1 = new ['Integer'] 775 $P1 = $I3 776 777 ex: 778 .end 779 780 .sub interface 781 $P0 = new ['BigInt'] 782 $I0 = does $P0, 'scalar' 783 is($I0,1,'Interface does scalar') 784 $I0 = does $P0, 'no_interface' 785 is($I0,0,'... and does not do bogus') 786 .end 787 788 .sub boolean 789 $P0 = new ['BigInt'] 790 791 $P0 = '123456789123456789' 792 $I0 = 1 793 if $P0, OK1 794 $I0 = 0 795 OK1: 796 797 $P0 = 0 798 unless $P0, OK2 799 $I0 = 0 800 OK2: 801 802 ok($I0, 'truth and falsehood') 803 .end 804 805 # How this next test was originally written in Python: 806 # 807 # class PI(object): 808 # def __iter__(self): 809 # k, a, b, a1, b1 = 2, 4, 1, 12, 4 810 # while 1: 811 # p, q, k = k*k, 2*k+1, k+1 812 # a, b, a1, b1 = a1, b1, p*a+q*a1, p*b+q*b1 813 # d, d1 = a//b, a1//b1 814 # while d == d1: 815 # yield d 816 # a, a1 = 10*(a%b), 10*(a1%b1) 817 # d, d1 = a//b, a1//b1 818 # 819 # pi = iter(PI()) 820 # ds = "" 821 # for i in xrange(1, 1001): 822 # d = pi.next() 823 # ds += str(d) 824 # im = i % 50 825 # if im == 0: 826 # print ds 827 # ds = "" 828 # 829 # print ds 830 # 831 832 .sub pi_generator 833 # k = $P6 834 $P6 = new ['Integer'] 835 $P6 = 2 836 # a = $P7 837 $P7 = new ['Integer'] 838 $P7 = 4 839 # b = $P8 840 $P8 = new ['Integer'] 841 $P8 = 1 842 # a1 = $P9 843 $P9 = new ['Integer'] 844 $P9 = 12 845 # b1 = $P10 846 $P10 = new ['Integer'] 847 $P10 = 4 848 restart: 849 # p = $P11 850 $P11 = mul $P6, $P6 851 # q = $P12 852 $P12 = mul $P6, 2 853 inc $P12 854 inc $P6 855 # ta = $P13 856 $P13 = clone $P9 857 # tb = $P14 858 $P14 = clone $P10 859 $P0 = mul $P11, $P7 860 $P1 = mul $P12, $P9 861 # ta1 = $P15 862 $P15 = add $P0, $P1 863 $P2 = mul $P11, $P8 864 $P3 = mul $P12, $P10 865 # tb1 = $P16 866 $P16 = add $P2, $P3 867 $P7 = $P13 868 $P8 = $P14 869 $P9 = $P15 870 $P10 = $P16 871 # d = $P17 872 $P17 = fdiv $P7, $P8 873 # d1 = $P18 874 $P18 = fdiv $P9, $P10 875 next: 876 ne $P17, $P18, restart 877 .yield($P17) 878 $P4 = mod $P7, $P8 879 $P7 = mul $P4, 10 880 $P5 = mod $P9, $P10 881 $P9 = mul $P5, 10 882 $P17 = fdiv $P7, $P8 883 $P18 = fdiv $P9, $P10 884 goto next 885 .end 886 887 .sub pi 888 $S0 = <<'EoN' 675 889 31415926535897932384626433832795028841971693993751 676 890 05820974944592307816406286208998628034825342117067 677 891 98214808651328230664709384460955058223172535940812 … … 692 906 17101000313783875288658753320838142061717766914730 693 907 35982534904287554687311595628638823537875937519577 694 908 81857780532171226806613001927876611195909216420198 909 EoN 695 910 696 OUTPUT 911 $I3 = 0 912 $I4 = length $S0 913 loop: 914 $P0 = pi_generator() 915 skip_ws: 916 $S1 = substr $S0,$I3,1 917 eq $S1, '', stop 918 inc $I3 919 eq $S1, '.', skip_ws 920 eq $S1, ' ', skip_ws 921 eq $S1, "\r", skip_ws 922 eq $S1, "\n", skip_ws 923 $I1 = $S1 924 $I0 = $P0 925 eq $I0, $I1, loop 926 stop: 927 is($I0, $I1, 'Computed 1000 digits of PI (using coroutine)') 928 eq $I0, $I1, ret 929 print 'Wrong digit ' 930 print $I0 931 print ' should have been ' 932 print $S1 933 print ' at position ' 934 print $I3 935 say '.' 936 ret: 937 .end 697 938 698 pasm_output_is( <<'CODE', <<'OUT', "shl_bigint" ); 699 new P0, ['BigInt'] 700 set P0, "2" 701 new P1, ['BigInt'] 702 set P1, 2 703 new P2, ['BigInt'] 704 shl P2, P0, P1 705 set S0, P2 706 print S0 707 print "\n" 708 set P0, "100000000000" 709 set P1, 10 710 shl P2, P0, P1 711 set S0, P2 712 print S0 713 print "\n" 714 end 715 CODE 716 8 717 102400000000000 718 OUT 939 .sub left_shift 940 $I1 = 1 719 941 720 pir_output_is( <<'CODE', <<'OUT', "shl_bigint with a negative shift" ); 721 ## cf the shr_bigint case. 722 .sub main :main 723 $P0 = new ['BigInt'] 724 set $P0, 8 725 $P1 = new ['BigInt'] 726 set $P1, -2 727 $P2 = new ['BigInt'] 728 shl $P2, $P0, $P1 729 say $P2 730 set $P0, "102400000000000" 731 set $P1, -10 732 shl $P2, $P0, $P1 733 say $P2 734 .end 735 CODE 736 2 737 100000000000 738 OUT 942 $P0 = new ['BigInt'] 943 $P1 = new ['BigInt'] 739 944 740 pasm_output_is( <<'CODE', <<'OUT', "shl_int" ); 741 new P0, ['BigInt'] 742 set P0, 2 743 new P1, ['Integer'] 744 set P1, 1 745 new P2, ['BigInt'] 746 shl P2, P0, P1 747 set S0, P2 748 print S0 749 print "\n" 750 set P0, "100000000000" 751 set P1, 1 752 shl P2, P0, P1 753 set S0, P2 754 print S0 755 print "\n" 756 set P0, "100000000000" 757 set P1, 10 758 shl P2, P0, P1 759 set S0, P2 760 print S0 761 print "\n" 762 end 763 CODE 764 4 765 200000000000 766 102400000000000 767 OUT 945 # shl with a positive shift 946 $P0 = 2 947 $P1 = 2 948 $P2 = new ['Integer'] 949 $P2 = shl $P0, $P1 950 $S0 = $P2 951 eq $S0, '8', OK1 952 $I1 = 0 953 say 'shl(bigint 2,bigint 2) did not return 8' 954 OK1: 955 $P0 = '100000000000' 956 $P1 = 10 957 $P2 = new ['Integer'] 958 $P2 = shl $P0, $P1 959 $S0 = $P2 960 eq $S0, '102400000000000', OK2 961 $I1 = 0 962 say 'shl(bigint 100000000000,bigint 10) did not return 102400000000000' 963 OK2: 768 964 769 pir_output_is( <<'CODE', <<'OUT', "shl_int with a negative shift" ); 770 ## cf the shr_int case. 771 .sub main :main 772 $P0 = new ['BigInt'] 773 set $P0, 4 774 $P1 = new ['Integer'] 775 set $P1, -1 776 $P2 = new ['BigInt'] 777 shl $P2, $P0, $P1 778 say $P2 779 set $P0, "200000000000" 780 set $P1, -1 781 shl $P2, $P0, $P1 782 say $P2 783 set $P0, "102400000000000" 784 set $P1, -10 785 shl $P2, $P0, $P1 786 say $P2 787 .end 788 CODE 789 2 790 100000000000 791 100000000000 792 OUT 965 # shl with a negative shift 966 $P0 = 8 967 $P1 = -2 968 $P2 = new ['Integer'] 969 $P2 = shl $P0, $P1 970 $S0 = $P2 971 is($S0, '2', 'shl(bigint, -bigint)') 972 $P0 = '102400000000000' 973 $P1 = -10 974 $P2 = new ['Integer'] 975 $P2 = shl $P0, $P1 976 $S0 = $P2 977 eq $S0, '100000000000', OK3 978 $I1 = 0 979 say 'shl(bigint 102400000000000,bigint -10) did not return 100000000000' 980 OK3: 793 981 794 pir_output_like( <<'CODE', <<'OUT', "shl_int and i_shl_int promote Integer to Bigint" ); 795 ## The result on the second line is a BigInt on 32-bit systems and still an 796 ## Integer on 64-bit systems. 797 .sub main :main 798 $P0 = new ['Integer'] 799 set $P0, 1000001 800 $P1 = new ['Integer'] 801 set $P1, 10 802 $P2 = new ['Integer'] 803 ## shift by 10 bits . . . 804 shl $P2, $P0, $P1 805 $S2 = typeof $P2 806 print $S2 807 print ' ' 808 say $P2 809 ## then by 20 bits . . . 810 $P1 = 20 811 $P3 = new ['Integer'] 812 $P3 = 1000001 813 shl $P3, $P0, $P1 814 $S2 = typeof $P3 815 print $S2 816 print ' ' 817 say $P3 818 ## then by another 40 bits (total 60) in place. 819 $P1 = 40 820 shl $P3, $P3, $P1 821 $S2 = typeof $P3 822 print $S2 823 print ' ' 824 say $P3 825 .end 826 CODE 827 /Integer 1024001024 828 (Integer|BigInt) 1048577048576 829 BigInt 1152922657528351582846976 830 / 831 OUT 982 ok($I1, 'shl(bigint, +bigint)') 983 $I1 = 1 832 984 833 pir_error_output_like( <<'CODE', <<'OUT', "shl_int throws an error when promotion is disabled" ); 834 .include "errors.pasm" 835 .sub main :main 836 errorson .PARROT_ERRORS_OVERFLOW_FLAG 837 $P0 = new ['Integer'] 838 set $P0, 1000001 839 $P1 = new ['Integer'] 840 set $P1, 10 841 $P2 = new ['Integer'] 842 ## shift by 10 bits . . . 843 shl $P2, $P0, $P1 844 $S2 = typeof $P2 845 print $S2 846 print ' ' 847 say $P2 848 ## then by 60 bits. 849 $P1 = 60 850 $P0 = 1000001 851 shl $P3, $P0, $P1 852 $S2 = typeof $P3 853 print $S2 854 print ' ' 855 say $P3 856 .end 857 CODE 858 /Integer 1024001024 859 Integer overflow 860 current instr/ 861 OUT 985 # shl_int with a positive shift 986 $P0 = 2 987 $P1 = 1 988 $P2 = new ['Integer'] 989 $P2 = shl $P0, $P1 990 $S0 = $P2 991 eq $S0, '4', OK4 992 $I1 = 0 993 say 'shl(bigint 2,integer 1) did not return 4' 994 OK4: 995 $P0 = '100000000000' 996 $P1 = 1 997 $P2 = new ['Integer'] 998 $P2 = shl $P0, $P1 999 $S0 = $P2 1000 eq $S0, '200000000000', OK5 1001 $I1 = 0 1002 say 'shl(bigint 100000000000,integer 1) did not return 200000000000' 1003 OK5: 1004 $P0 = '100000000000' 1005 $P1 = 10 1006 $P2 = new ['Integer'] 1007 $P2 = shl $P0, $P1 1008 $S0 = $P2 1009 eq $S0, '102400000000000', OK6 1010 $I1 = 0 1011 say 'shl(bigint 100000000000,integer 10) did not return 102400000000000' 1012 OK6: 862 1013 863 pir_output_is( <<'CODE', <<'OUT', "shl_int by 64 bits also promotes to Bigint" ); 1014 # shl_int with a negative shift 1015 1016 $P0 = 4 1017 $P1 = -1 1018 $P2 = new ['Integer'] 1019 $P2 = shl $P0, $P1 1020 $S0 = $P2 1021 eq $S0, '2', OK7 1022 $I1 = 0 1023 say 'shl(bigint 4,integer -1) did not return 2' 1024 OK7: 1025 $P0 = '200000000000' 1026 $P1 = -1 1027 $P2 = new ['Integer'] 1028 $P2 = shl $P0, $P1 1029 $S0 = $P2 1030 eq $S0, '100000000000', OK8 1031 $I1 = 0 1032 say 'shl(bigint 200000000000,integer -1) did not return 100000000000' 1033 OK8: 1034 $P0 = '102400000000000' 1035 $P1 = -10 1036 $P2 = new ['Integer'] 1037 $P2 = shl $P0, $P1 1038 $S0 = $P2 1039 eq $S0, '100000000000', OK9 1040 $I1 = 0 1041 say 'shl(bigint 102400000000000,integer -10) did not return 100000000000' 1042 OK9: 1043 ok($I1, 'shl(bigint,integer)') 1044 $I1 = 1 1045 1046 # shl_int throws an error when promotion is disabled 1047 1048 errorson .PARROT_ERRORS_OVERFLOW_FLAG 1049 $P0 = new ['Integer'] 1050 $P0 = 1000001 1051 $P1 = new ['Integer'] 1052 $P1 = 10 1053 1054 ## shift by 10 bits . . . 1055 $P2 = new ['Integer'] 1056 $P2 = shl $P0, $P1 1057 $S1 = $P2 1058 $S2 = typeof $P2 1059 eq $S2, 'Integer', OK11 1060 $I1 = 0 1061 print 'shl(integer 1000001,integer 10) did not return an Integer PMC; got a ' 1062 print $S2 1063 say ' instead.' 1064 1065 OK11: 1066 eq $S1,'1024001024', OK12 1067 $I1 = 0 1068 print 'shl(integer 1000001,integer 10) did not return 1024001024; got ' 1069 print $S1 1070 say ' instead.' 1071 OK12: 1072 1073 ## then by 60 bits. 1074 $P0 = 1000001 1075 $P1 = 60 1076 push_eh E1 1077 $I1 = 1 1078 $P2 = new ['Integer'] 1079 $P2 = shl $P0, $P1 1080 $I1 = 0 1081 $S1 = $P2 1082 $S2 = typeof $P2 1083 print 'Failed to throw exception; return type ' 1084 print $S2 1085 print ', return value ' 1086 say $P1 1087 E1: 1088 pop_eh 1089 get_results '0', $P2 1090 $S0 = $P2 1091 eq $S0, 'Integer overflow', OK13 1092 $I1 = 0 1093 say 'shl(integer 1000001, integer 60) throws exception, but wrong type' 1094 OK13: 1095 ok($I1, 'shl(integer 1000001, integer 60) throws "Integer overflow" exception') 1096 $I1 = 1 1097 1098 # shl_int and i_shl_int promote Integer to Bigint 1099 1100 errorsoff .PARROT_ERRORS_OVERFLOW_FLAG 1101 ## shift left by 20 bits ... 1102 $P0 = new ['Integer'] 1103 $P0 = 1000001 1104 $P1 = new ['Integer'] 1105 $P1 = 20 1106 $P2 = new ['Integer'] 1107 $P2 = shl $P0, $P1 1108 ## ... then by another 40 bits (total 60) in place. 1109 $P1 = 40 1110 $P2 = shl $P2, $P1 1111 $S1 = $P2 1112 $S2 = typeof $P2 1113 eq $S2, 'BigInt', OK14 1114 $S1 = '' 1115 OK14: 1116 is($S1, '1152922657528351582846976', 'shl(shl(integer 1000001, 20), 40) => bigint 1152922657528351582846976') 1117 1118 # shl_int by 64 bits also promotes to Bigint 864 1119 ## The C << and >> ops take the right arg modulo the word size in bits (at least 865 1120 ## on all the systems I have available), so both 32- and 64-bit systems treat 866 1121 ## shifting by 64 bits as shifting by zero. 867 .sub main :main 868 $P0 = new ['Integer'] 869 set $P0, 1000001 870 $P1 = new ['Integer'] 871 set $P1, 64 872 shl $P2, $P0, $P1 873 $S2 = typeof $P2 874 print $S2 875 print ' ' 876 say $P2 1122 $P0 = new ['Integer'] 1123 $P0 = 1000001 1124 $P1 = new ['Integer'] 1125 $P1 = 64 1126 $P2 = new ['Integer'] 1127 $P2 = shl $P0, $P1 1128 $S1 = $P2 1129 $S2 = typeof $P2 1130 eq $S2, 'BigInt', OK15 1131 $S1 = '' 1132 OK15: 1133 is($S1, '18446762520453625325551616', 'shl(integer 1000001, 64) => bigint 18446762520453625325551616') 877 1134 .end 878 CODE879 BigInt 18446762520453625325551616880 OUT881 1135 882 pir_output_is( 883 <<'CODE', <<'OUT', "shr_int and i_shr_int with a neg shift promote Integer to Bigint" ); 884 .sub main :main 885 $P0 = new ['Integer'] 886 set $P0, 1000001 887 $P1 = new ['Integer'] 888 set $P1, -10 889 $P2 = new ['Integer'] 890 ## shift by 10 bits . . . 891 shr $P2, $P0, $P1 892 $S2 = typeof $P2 893 print $S2 894 print ' ' 895 say $P2 896 ## then by another 50 bits (total 60) in place. 897 $P1 = -50 898 shr $P2, $P1 899 $S2 = typeof $P2 900 print $S2 901 print ' ' 902 say $P2 903 .end 904 CODE 905 Integer 1024001024 906 BigInt 1152922657528351582846976 907 OUT 1136 .sub right_shift 1137 $I1 = 1 1138 #shr_int and i_shr_int with a neg shift promote Integer to Bigint 908 1139 909 pasm_output_is( <<'CODE', <<'OUT', "shr_bigint" ); 910 new P0, ['BigInt'] 911 set P0, 8 912 new P1, ['BigInt'] 913 set P1, 2 914 new P2, ['BigInt'] 915 shr P2, P0, P1 916 set S0, P2 917 print S0 918 print "\n" 919 set P0, "102400000000000" 920 set P1, 10 921 shr P2, P0, P1 922 set S0, P2 923 print S0 924 print "\n" 925 end 926 CODE 927 2 928 100000000000 929 OUT 1140 $P0 = new ['Integer'] 1141 $P0 = 1000001 1142 $P1 = new ['Integer'] 1143 $P1 = -10 1144 $P2 = new ['Integer'] 1145 ## shift by 10 bits . . . 1146 $P2 = shr $P0, $P1 1147 # $S2 = typeof $P2 1148 # ne $S2, 'Integer', OK2 930 1149 931 pir_output_is( <<'CODE', <<'OUT', "shr_bigint with a negative shift" ); 1150 ## then by another 50 bits (total 60) in place. 1151 $P1 = -50 1152 $P2 = shr $P1 1153 $S1 = $P2 1154 $S2 = typeof $P2 1155 eq $S2, 'BigInt', OK2 1156 $S1 = '' 1157 OK2: 1158 is($S1, '1152922657528351582846976', 'shr(shr(integer 1000001, integer -10), -50) => bigint 1152922657528351582846976') 1159 1160 # shr_bigint 1161 $P0 = new ['BigInt'] 1162 $P0 = 8 1163 $P1 = new ['BigInt'] 1164 $P1 = 2 1165 $P2 = new ['BigInt'] 1166 $P2 = shr $P0, $P1 1167 $S0 = $P2 1168 eq $S0, '2', OK3 1169 $I1 = 0 1170 say 'shr(bigint 8, bigint 2) did not return 2' 1171 OK3: 1172 1173 $P0 = '102400000000000' 1174 $P1 = 10 1175 $P2 = shr $P0, $P1 1176 $S0 = $P2 1177 eq $S0, '100000000000', OK4 1178 $I1 = 0 1179 say 'shr(bigint 102400000000000, bigint 10) did not return 100000000000' 1180 OK4: 1181 ok($I1, 'shr(bigint, +bigint)') 1182 $I1 = 1 1183 1184 # shr_bigint with a negative shift 932 1185 ## cf the shl_bigint case. 933 .sub main :main934 $P0 = new ['BigInt']935 set $P0, 2936 $P1 = new['BigInt']937 set $P1, -2938 $P2 = new ['BigInt']939 shr $P2, $P0, $P1940 say $P2941 set $P0, "100000000000"942 set $P1, -10943 shr $P2, $P0, $P1944 say $P2945 .end946 CODE947 8948 102400000000000949 OUT950 1186 951 pasm_output_is( <<'CODE', <<'OUT', "shr_int" ); 952 new P0, ['BigInt'] 953 set P0, 4 954 new P1, ['Integer'] 955 set P1, 1 956 new P2, ['BigInt'] 957 shr P2, P0, P1 958 set S0, P2 959 print S0 960 print "\n" 961 set P0, "200000000000" 962 set P1, 1 963 shr P2, P0, P1 964 set S0, P2 965 print S0 966 print "\n" 967 set P0, "102400000000000" 968 set P1, 10 969 shr P2, P0, P1 970 set S0, P2 971 print S0 972 print "\n" 973 end 974 CODE 975 2 976 100000000000 977 100000000000 978 OUT 1187 $P0 = new ['BigInt'] 1188 $P0 = 2 1189 $P1 = new['BigInt'] 1190 $P1 = -2 1191 $P2 = new ['BigInt'] 1192 $P2 = shr $P0, $P1 1193 $S0 = $P2 1194 eq $S0, '8', OK5 1195 $I1 = 0 1196 say 'shr(bigint 2, bigint -2) did not return 8' 1197 OK5: 979 1198 980 pir_output_is( <<'CODE', <<'OUT', "shr_int with a negative shift" ); 1199 $P0 = '100000000000' 1200 $P1 = -10 1201 $P2 = shr $P0, $P1 1202 $S0 = $P2 1203 eq $S0, '102400000000000', OK6 1204 $I1 = 0 1205 say 'shr(bigint 100000000000, bigint -10) did not return 102400000000000' 1206 OK6: 1207 ok($I1, 'shr(bigint, -bigint)') 1208 $I1 = 1 1209 1210 # shr_int 1211 $P0 = new ['BigInt'] 1212 $P0 = 4 1213 $P1 = new ['Integer'] 1214 $P1 = 1 1215 $P2 = new ['BigInt'] 1216 $P2 = shr $P0, $P1 1217 $S0 = $P2 1218 eq $S0, '2', OK7 1219 $I1 = 0 1220 say 'shr(bigint 4, integer 1) did not return 2' 1221 OK7: 1222 1223 $P0 = '200000000000' 1224 $P1 = 1 1225 $P2 = shr $P0, $P1 1226 $S0 = $P2 1227 eq $S0, '100000000000', OK8 1228 $I1 = 0 1229 say 'shr(bigint 200000000000, integer 1) did not return 100000000000' 1230 OK8: 1231 1232 $P0 = '102400000000000' 1233 $P1 = 10 1234 $P2 = shr $P0, $P1 1235 $S0 = $P2 1236 eq $S0, '100000000000', OK9 1237 $I1 = 0 1238 say 'shr(bigint 102400000000000, integer 10) did not return 100000000000' 1239 OK9: 1240 1241 ok($I1,'shr(bigint, +integer)') 1242 $I1 = 1 1243 1244 # shr_int with a negative shift 981 1245 ## cf the shl_int case. 982 .sub main :main983 $P0 = new ['BigInt']984 set $P0, 2985 $P1 = new ['Integer']986 set $P1, -1987 $P2 = new ['BigInt']988 shr $P2, $P0, $P1989 say $P2990 set $P0, "100000000000"991 set $P1, -1992 shr $P2, $P0, $P1993 say $P2994 set $P1, -10995 shr $P2, $P0, $P1996 say $P2997 .end998 CODE999 41000 2000000000001001 1024000000000001002 OUT1003 1246 1004 pir_output_is( <<'CODE', <<'OUT', "BUG #34949 gt" ); 1005 .sub main :main 1006 .local pmc b 1007 b = new ['BigInt'] 1008 b = 1e10 1009 if b > 4 goto ok 1010 print "never\n" 1011 end 1012 ok: 1013 print "ok\n" 1014 .end 1015 CODE 1016 ok 1017 OUT 1247 $P0 = new ['BigInt'] 1248 $P0 = 2 1249 $P1 = new ['Integer'] 1250 $P1 = -1 1251 $P2 = new ['BigInt'] 1252 $P2 = shr $P0, $P1 1253 $S0 = $P2 1254 eq $S0, '4', OK10 1255 $I1 = 0 1256 say 'shr(bigint 2, int -1) did not return 4' 1257 OK10: 1018 1258 1019 pir_output_is( <<'CODE', <<'OUT', "BUG #34949 ge" ); 1020 .sub main :main 1021 .local pmc b 1022 b = new ['BigInt'] 1023 b = 1e10 1024 if b >= 4 goto ok 1025 print "never\n" 1026 end 1027 ok: 1028 print "ok\n" 1029 .end 1030 CODE 1031 ok 1032 OUT 1259 $P0 = '100000000000' 1260 $P1 = -1 1261 $P2 = new ['BigInt'] 1262 $P2 = shr $P0, $P1 1263 $S0 = $P2 1264 eq $S0, '200000000000', OK11 1265 $I1 = 0 1266 say 'shr(bigint 100000000000, int -1) did not return 200000000000' 1267 OK11: 1033 1268 1034 pir_output_is( <<'CODE', <<'OUT', "BUG #34949 ne" ); 1035 .sub main :main 1036 .local pmc b 1037 b = new ['BigInt'] 1038 b = 1e10 1039 if b != 4 goto ok 1040 print "never\n" 1041 end 1042 ok: 1043 print "ok\n" 1044 .end 1045 CODE 1046 ok 1047 OUT 1269 $P1 = -10 1270 $P2 = new ['BigInt'] 1271 $P2 = shr $P0, $P1 1272 $S0 = $P2 1273 eq $S0, '102400000000000', OK12 1274 $I1 = 0 1275 say 'shr(bigint 100000000000,int -10) did not return 102400000000000' 1276 OK12: 1048 1277 1049 pir_output_is( <<'CODE', <<'OUT', "BUG #34949 eq" ); 1050 .sub main :main 1051 .local pmc b 1052 b = new ['BigInt'] 1053 b = 1e10 1054 if b == 4 goto nok 1055 print "ok\n" 1056 end 1057 nok: 1058 print "nok\n" 1278 ok($I1,'shr(bigint, -integer)') 1059 1279 .end 1060 CODE1061 ok1062 OUT1063 1280 1064 pir_output_is( <<'CODE', <<'OUT', "BUG #34949 le" ); 1065 .sub main :main 1066 .local pmc b 1067 b = new ['BigInt'] 1068 b = 1e10 1069 if b <= 4 goto nok 1070 print "ok\n" 1071 end 1072 nok: 1073 print "nok\n" 1074 .end 1075 CODE 1076 ok 1077 OUT 1281 .sub bugfixes 1078 1282 1079 pir_output_is( <<'CODE', <<'OUT', "BUG #34949 lt" ); 1080 .sub main :main 1081 .local pmc b 1082 b = new ['BigInt'] 1083 b = 1e10 1084 if b < 4 goto nok 1085 print "ok\n" 1086 end 1087 nok: 1088 print "nok\n" 1283 $P0 = new ['BigInt'] 1284 $P0 = 1e10 1285 $I1 = 1 1286 gt $P0, 4, OK1 1287 $I1 = 0 1288 OK1: 1289 ok($I1, 'BUG #34949 gt') 1290 1291 $P0 = new ['BigInt'] 1292 $P0 = 1e10 1293 $I1 = 1 1294 ge $P0, 4, OK2 1295 $I1 = 0 1296 OK2: 1297 ok($I1, 'BUG #34949 ge') 1298 1299 $P0 = new ['BigInt'] 1300 $P0 = 1e10 1301 $I1 = 1 1302 ne $P0, 4, OK3 1303 $I1 = 0 1304 OK3: 1305 ok($I1, 'BUG #34949 ne') 1306 1307 $P0 = new ['BigInt'] 1308 $P0 = 1e10 1309 $I1 = 0 1310 eq $P0, 4, NOK4 1311 $I1 = 1 1312 NOK4: 1313 ok($I1, 'BUG #34949 eq') 1314 1315 $P0 = new ['BigInt'] 1316 $P0 = 1e10 1317 $I1 = 0 1318 lt $P0, 4, NOK5 1319 $I1 = 1 1320 NOK5: 1321 ok($I1, 'BUG #34949 le') 1322 1323 $P0 = new ['BigInt'] 1324 $P0 = 1e10 1325 $I1 = 0 1326 lt $P0, 4, NOK6 1327 $I1 = 1 1328 NOK6: 1329 ok($I1, 'BUG #34949 lt') 1330 1089 1331 .end 1090 CODE1091 ok1092 OUT1093 1332 1094 1333 # Local Variables: 1095 # mode: cperl1334 # mode: pir 1096 1335 # cperl-indent-level: 4 1097 1336 # fill-column: 100 1098 1337 # End: