t/pmc/bigint.t

   1 #! perl
   2 # Copyright (C) 2001-2007, Parrot Foundation.
   3 # $Id$
   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 =head1 NAME
  14
  15 t/pmc/bigint.t - BigInt PMC
  16
  17 =head1 SYNOPSIS
  18
  19     % prove t/pmc/bigint.t
  20
  21 =head1 DESCRIPTION
  22
  23 Tests the BigInt PMC.
  24
  25 =cut
  26
  27 if ( $PConfig{gmp} ) {
  28     plan tests => 44;
  29 }
  30 else {
  31     plan skip_all => "No BigInt Lib configured";
  32 }
  33
  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:
  59 .end
  60 EOP
  61
  62 if ( $PConfig{gmp} ) {
  63
  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 }
  74
  75 pasm_output_is( <<'CODE', <<'OUT', "create" );
  76    new P0, ['BigInt']
  77    print "ok\n"
  78    end
  79 CODE
  80 ok
  81 OUT
  82
  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
  97
  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"
 106
 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"
 112
 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"
 118
 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
 131
 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
 141
 142 pasm_output_is( <<'CODE', <<'OUT', "set str, get str" );
 143    new P0, ['BigInt']
 144    set P0, "1230000000000"
 145    print P0
 146    print "\n"
 147    end
 148 CODE
 149 1230000000000
 150 OUT
 151
 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
 173
 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
 192
 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
 223
 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
 245
 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
 285
 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
 300
 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
 312
 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"
 324
 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"
 332
 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"
 339
 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
 353
 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"
 364
 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
 376
 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"
 389
 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
 403
 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"
 424 .end
 425 CODE
 426 ok
 427 Divide by zero
 428 OUTPUT
 429     }
 430 }
 431
 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     }
 451
 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
 480
 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 }
 510
 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
 529
 530 pir_output_is( << 'CODE', << 'OUTPUT', "check whether interface is done" );
 531
 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
 543 .end
 544 CODE
 545 1
 546 0
 547 OUTPUT
 548
 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
 564
 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
 578
 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
 626 .end
 627
 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"
 642 .end
 643
 644 =begin python
 645
 646 class PI(object):
 647     def __iter__(self):
 648         k, a, b, a1, b1 = 2, 4, 1, 12, 4
 649         while 1:
 650             p, q, k = k*k, 2*k+1, k+1
 651             a, b, a1, b1 = a1, b1, p*a+q*a1, p*b+q*b1
 652             d, d1 = a//b, a1//b1
 653             while d == d1:
 654                 yield d
 655                 a, a1 = 10*(a%b), 10*(a1%b1)
 656                 d, d1 = a//b, a1//b1
 657
 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 = ""
 667
 668 print ds
 669
 670 =end python
 671
 672 =cut
 673
 674 CODE
 675 31415926535897932384626433832795028841971693993751
 676 05820974944592307816406286208998628034825342117067
 677 98214808651328230664709384460955058223172535940812
 678 84811174502841027019385211055596446229489549303819
 679 64428810975665933446128475648233786783165271201909
 680 14564856692346034861045432664821339360726024914127
 681 37245870066063155881748815209209628292540917153643
 682 67892590360011330530548820466521384146951941511609
 683 43305727036575959195309218611738193261179310511854
 684 80744623799627495673518857527248912279381830119491
 685 29833673362440656643086021394946395224737190702179
 686 86094370277053921717629317675238467481846766940513
 687 20005681271452635608277857713427577896091736371787
 688 21468440901224953430146549585371050792279689258923
 689 54201995611212902196086403441815981362977477130996
 690 05187072113499999983729780499510597317328160963185
 691 95024459455346908302642522308253344685035261931188
 692 17101000313783875288658753320838142061717766914730
 693 35982534904287554687311595628638823537875937519577
 694 81857780532171226806613001927876611195909216420198
 695
 696 OUTPUT
 697
 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
 719
 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
 739
 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
 768
 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
 793
 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
 832
 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
 862
 863 pir_output_is( <<'CODE', <<'OUT', "shl_int by 64 bits also promotes to Bigint" );
 864 ## The C << and >> ops take the right arg modulo the word size in bits (at least
 865 ## on all the systems I have available), so both 32- and 64-bit systems treat
 866 ## 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
 877 .end
 878 CODE
 879 BigInt 18446762520453625325551616
 880 OUT
 881
 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
 908
 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
 930
 931 pir_output_is( <<'CODE', <<'OUT', "shr_bigint with a negative shift" );
 932 ## cf the shl_bigint case.
 933 .sub main :main
 934    $P0 = new ['BigInt']
 935    set $P0, 2
 936    $P1 = new['BigInt']
 937    set $P1, -2
 938    $P2 = new ['BigInt']
 939    shr $P2, $P0, $P1
 940    say $P2
 941    set $P0, "100000000000"
 942    set $P1, -10
 943    shr $P2, $P0, $P1
 944    say $P2
 945 .end
 946 CODE
 947 8
 948 102400000000000
 949 OUT
 950
 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
 979
 980 pir_output_is( <<'CODE', <<'OUT', "shr_int with a negative shift" );
 981 ## cf the shl_int case.
 982 .sub main :main
 983    $P0 = new ['BigInt']
 984    set $P0, 2
 985    $P1 = new ['Integer']
 986    set $P1, -1
 987    $P2 = new ['BigInt']
 988    shr $P2, $P0, $P1
 989    say $P2
 990    set $P0, "100000000000"
 991    set $P1, -1
 992    shr $P2, $P0, $P1
 993    say $P2
 994    set $P1, -10
 995    shr $P2, $P0, $P1
 996    say $P2
 997 .end
 998 CODE
 999 4
1000 200000000000
1001 102400000000000
1002 OUT
1003
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
1018
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
1033
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
1048
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"
1059 .end
1060 CODE
1061 ok
1062 OUT
1063
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
1078
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"
1089 .end
1090 CODE
1091 ok
1092 OUT
1093
1094 # Local Variables:
1095 #   mode: cperl
1096 #   cperl-indent-level: 4
1097 #   fill-column: 100
1098 # End:
1099 # vim: expandtab shiftwidth=4: