t/pmc/bignum.t

   1 #! perl
   2 # Copyright (C) 2009, 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/bignum.t - BigNum PMC
  16
  17 =head1 SYNOPSIS
  18
  19     % prove t/pmc/bignum.t
  20
  21 =head1 DESCRIPTION
  22
  23 Tests the BigNum PMC.
  24
  25 =cut
  26
  27 if ( $PConfig{gmp} ) {
  28     plan tests => 33;
  29 }
  30 else {
  31     plan skip_all => "No BigNum PMC enabled";
  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 ['BigNum']
  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     say " is buggy with huge digit multiply - please upgrade"
  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, ['BigNum']
  77    say "ok"
  78    end
  79 CODE
  80 ok
  81 OUT
  82
  83 pasm_output_is( <<'CODE', <<'OUT', "set/get int" );
  84    new P0, ['BigNum']
  85    set P0, 999999
  86    set I1, P0
  87    say I1
  88    get_repr S0, P0
  89    say S0
  90    end
  91 CODE
  92 999999
  93 999999N
  94 OUT
  95
  96 pasm_output_is( <<"CODE", <<'OUT', "set int, get double" );
  97      .include 'fp_equality.pasm'
  98      new P0, ['BigNum']
  99      set P0, 999999
 100      set N1, P0
 101      .fp_eq_pasm(N1, 999999.0, OK1)
 102      print "not "
 103 OK1: say "ok 1"
 104
 105      set P0, -999999
 106      set N1, P0
 107      .fp_eq_pasm(N1, -999999.0, OK2)
 108      print "not "
 109 OK2: say "ok 2"
 110
 111      set P0, 2147483646
 112      set N1, P0
 113      .fp_eq_pasm(N1, 2.147483646e9, OK3)
 114      print "not "
 115 OK3: say "ok 3"
 116
 117      set P0, -2147483646
 118      set N1, P0
 119      .fp_eq_pasm(N1, -2.147483646e9, OK4)
 120      print "not "
 121 OK4: say "ok 4"
 122      end
 123 CODE
 124 ok 1
 125 ok 2
 126 ok 3
 127 ok 4
 128 OUT
 129
 130 my @todo_str = ( todo => "bignum strings");
 131 pasm_output_is( <<'CODE', <<'OUT', "set double, get str", @todo_str );
 132    new P0, ['BigNum']
 133    set P0, 1.23e12
 134    say P0
 135    set P0, "1230000000000.0000000000000000122"
 136    say P0
 137    end
 138 CODE
 139 1230000000000
 140 1230000000000.0000000000000000122
 141 OUT
 142
 143 pasm_output_is( <<'CODE', <<'OUT', "add", @todo_str);
 144    new P0, ['BigNum']
 145    set P0, 999999.5
 146    new P1, ['BigNum']
 147    set P1, 1000000.5
 148    new P2, ['BigNum']
 149    add P2, P0, P1
 150    set S0, P2
 151    say S0
 152    set P0, "12345678987654321"
 153    set P1, "10000000000000000"
 154    add P2, P1, P0
 155    set S0, P2
 156    say S0
 157    end
 158 CODE
 159 2000000
 160 22345678987654321
 161 OUT
 162
 163 pasm_output_is( <<'CODE', <<'OUT', "add_int", @todo_str );
 164    new P0, ['BigNum']
 165    set P0, 999999
 166    new P2, ['BigNum']
 167    add P2, P0, 1000000
 168    set S0, P2
 169    say S0
 170    set P0, "100000000000000000000.01"
 171    add P2, P0, 1000000
 172    set S0, P2
 173    say S0
 174    end
 175 CODE
 176 1999999
 177 100000000000001000000.01
 178 OUT
 179
 180 pasm_output_is( <<'CODE', <<'OUTPUT', "sub bignum" );
 181      new P0, ['BigNum']
 182      set P0, 12345678
 183      new P1, ['BigNum']
 184      set P1, 5678
 185      new P2, ['BigNum']
 186      sub P2, P0, P1
 187      set I0, P2
 188      eq I0, 12340000, OK1
 189      print "not "
 190 OK1: say "ok 1"
 191      set P0, "123456789012345678"
 192      sub P2, P0, P1
 193      new P3, ['BigNum']
 194      set P3, "123456789012340000"
 195      eq P2, P3, OK2
 196      print "not "
 197 OK2: say "ok 2"
 198      set P1, "223456789012345678"
 199      sub P2, P0, P1
 200      set P3, "-100000000000000000"
 201      eq P2, P3, OK3
 202      print "not "
 203 OK3: say "ok 3"
 204      end
 205 CODE
 206 ok 1
 207 ok 2
 208 ok 3
 209 OUTPUT
 210
 211 pasm_output_is( <<'CODE', <<'OUTPUT', "sub native int" );
 212      new P0, ['BigNum']
 213      set P0, 12345678
 214      new P2, ['BigNum']
 215      sub P2, P0, 5678
 216      set I0, P2
 217      eq I0, 12340000, OK1
 218      print "not "
 219 OK1: say "ok 1"
 220      set P0, "123456789012345678"
 221      sub P2, P0, 5678
 222      new P3, ['BigNum']
 223      set P3, "123456789012340000"
 224      eq P2, P3, OK2
 225      print "not "
 226 OK2: say "ok 2"
 227      end
 228 CODE
 229 ok 1
 230 ok 2
 231 OUTPUT
 232
 233 pasm_output_is( <<'CODE', <<'OUTPUT', "sub other int" );
 234      new P0, ['BigNum']
 235      set P0, 12345678
 236      new P1, ['Integer']
 237      set P1, 5678
 238      new P2, ['BigNum']
 239      sub P2, P0, P1
 240      set I0, P2
 241      eq I0, 12340000, OK1
 242      print "not "
 243 OK1: say "ok 1"
 244      set P0, "123456789012345678"
 245      sub P2, P0, P1
 246      new P3, ['BigNum']
 247      set P3, "123456789012340000"
 248      eq P2, P3, OK2
 249      print "not "
 250 OK2: say "ok 2"
 251      set P0, 9876543
 252      new P4, ['Integer']
 253      set P4, 44
 254      sub P2, P0, P4
 255      set I0, P2
 256      eq I0, 9876499, OK3
 257      print "not "
 258 OK3: say "ok 3"
 259      set P0, "9876543219876543"
 260      sub P2, P0, P4
 261      set P3, "9876543219876499"
 262      eq P3, P2, OK4
 263      print "not "
 264 OK4: say "ok 4"
 265      end
 266 CODE
 267 ok 1
 268 ok 2
 269 ok 3
 270 ok 4
 271 OUTPUT
 272
 273 pasm_output_is( <<'CODE', <<'OUT', "mul", @todo_str );
 274    new P0, ['BigNum']
 275    set P0, 999.999
 276    new P1, ['BigNum']
 277    set P1, 10.000005
 278    new P2, ['BigNum']
 279    mul P2, P0, P1
 280    set S0, P2
 281    say S0
 282    end
 283 CODE
 284 9999.994999995
 285 OUT
 286
 287 pasm_output_is( <<'CODE', <<'OUT', "mul_float", @todo_str);
 288    new P0, ['BigNum']
 289    set P0, 999.999
 290    mul P2, P0, 10.000005
 291    say P2
 292    end
 293 CODE
 294 9999.994999995
 295 OUT
 296
 297 pasm_output_is( <<'CODE', <<'OUT', "div bignum" );
 298      new P0, ['BigNum']
 299      set P0, "100000000000000000000"
 300      new P1, ['BigNum']
 301      set P1, "100000000000000000000"
 302      new P2, ['BigNum']
 303      div P2, P0, P1
 304      set I0, P2
 305      eq I0, 1, OK1
 306      print "not "
 307 OK1: say "ok 1"
 308
 309      new P3, ['BigNum']
 310      set P3, "10000000000000"
 311      set P1, 10000000
 312      div P2, P0, P1
 313      eq  P2, P3, OK2
 314      print "not "
 315 OK2: say "ok 2"
 316
 317      set P1, 10
 318      set P3, "10000000000000000000"
 319      div P2, P0, P1
 320      eq  P2, P3, OK3
 321      print "not "
 322 OK3: say "ok 3"
 323
 324      set P1, -1
 325      set P3, "-100000000000000000000"
 326      div P2, P0, P1
 327      eq  P2, P3, OK4
 328      print "not "
 329 OK4: say "ok 4"
 330      end
 331 CODE
 332 ok 1
 333 ok 2
 334 ok 3
 335 ok 4
 336 OUT
 337
 338 pasm_output_is( <<'CODE', <<'OUT', "div native int" );
 339      new P0, ['BigNum']
 340      set P0, "100000000000000000000"
 341      new P1, ['BigNum']
 342      div P1, P0, 10
 343      new P2, ['BigNum']
 344      set P2, "10000000000000000000"
 345      eq P1, P2, OK1
 346      print "not "
 347 OK1: say "ok 1"
 348
 349      set P0, "100000000000000"
 350      div P1, P0, 10000000
 351      set P2, 10000000
 352      eq  P1, P2, OK2
 353      print "not "
 354 OK2: say "ok 2"
 355      end
 356 CODE
 357 ok 1
 358 ok 2
 359 OUT
 360
 361 pasm_output_is( <<'CODE', <<'OUT', "div other int" );
 362      new P0, ['BigNum']
 363      set P0, "100000000000000000000"
 364      new P1, ['BigNum']
 365      new P3, ['Integer']
 366      set P3, 10
 367      div P1, P0, P3
 368      new P2, ['BigNum']
 369      set P2, "10000000000000000000"
 370      eq P1, P2, OK1
 371      print "not "
 372 OK1: say "ok 1"
 373
 374      set P0, "100000000000000"
 375      new P4, ['Integer']
 376      set P4, 10000000
 377      div P1, P0, P4
 378      set P2, 10000000
 379      eq  P1, P2, OK2
 380      print "not "
 381 OK2: say "ok 2"
 382      end
 383 CODE
 384 ok 1
 385 ok 2
 386 OUT
 387
 388 pasm_output_is( <<'CODE', <<'OUT', "div float" );
 389      new P0, ['BigNum']
 390      set P0, "100000000000000000000"
 391      new P1, ['BigNum']
 392      div P1, P0, 10.0
 393      new P2, ['BigNum']
 394      set P2, "10000000000000000000"
 395      eq P1, P2, OK1
 396      print "not "
 397 OK1: say "ok 1"
 398
 399      set P0, "100000000000000"
 400      div P1, P0, -10.0
 401      set P2, "-10000000000000"
 402      eq  P1, P2, OK2
 403      print "not "
 404 OK2: say "ok 2"
 405      end
 406 CODE
 407 ok 1
 408 ok 2
 409 OUT
 410
 411 my @todo_sig = ( todo => "missing signature" );
 412 for my $op ( "/", "%" ) {
 413     for my $type ( "BigNum", "BigInt", "Integer" ) {
 414         pir_output_is( <<"CODE", <<OUTPUT, "bignum $op by zero $type", ($op eq '/' and $type ne 'BigInt') ? () : @todo_sig );
 415 .sub _main :main
 416     \$P0 = new ['BigNum']
 417     set \$P0, "1000000000000000000000.123"
 418     \$P1 = new ['BigNum']
 419     ## divide by a zero $type
 420     \$P2 = new ['$type']
 421     set \$P2, 0
 422     push_eh OK
 423     \$P1 = \$P0 $op \$P2
 424     say "fail"
 425     pop_eh
 426 OK:
 427     get_results '0', \$P0
 428     \$S0 = \$P0
 429     say "ok"
 430     say \$S0
 431 .end
 432 CODE
 433 ok
 434 Divide by zero
 435 OUTPUT
 436     }
 437 }
 438
 439 {
 440     my ( $a, $b, $c, $d, $e );
 441     if ( $PConfig{intvalsize} == 8 ) {
 442         $a = '9223372036854775806';    # 2**63-2
 443         $b = '1';
 444         $c = '9223372036854775807';    # still Integer
 445         $d = '9223372036854775808';    # no more Integer
 446         $e = '9223372036854775809';    # still no more Integer
 447     }
 448     elsif ( $PConfig{intvalsize} == 4 ) {
 449         $a = '2147483646';             # 2**31-2
 450         $b = '1';
 451         $c = '2147483647';             # still Integer
 452         $d = '2147483648';             # no more PerlInt
 453         $e = '2147483649';             # still no more PerlInt
 454     }
 455     else {
 456         die "\$PConfig{intvalsize} == $PConfig{intvalsize}?\n";
 457     }
 458
 459     pasm_output_is( <<CODE, <<OUT, "add overflow Integer" );
 460    new P0, ['Integer']
 461    set P0, $a
 462    new P1, ['Integer']
 463    set P1, $b
 464    new P2, ['Integer']
 465    new P3, ['BigNum']
 466    set I3, 3
 467 lp:
 468    add P2, P0, P1
 469    set S0, P2
 470    print S0
 471    print " "
 472    typeof S1, P2
 473    say S1
 474    add P1, $b
 475    dec I3
 476    if I3, lp
 477    say "ok"
 478 ex:
 479    end
 480 CODE
 481 $c Integer
 482 $d BigInt
 483 $e BigInt
 484 ok
 485 OUT
 486
 487     pasm_output_is( <<CODE, <<OUT, "add overflow Integer" );
 488    new P0, ['Integer']
 489    set P0, $a
 490    new P1, ['Integer']
 491    set P1, $b
 492    new P2, ['Integer']
 493    new P3, ['BigNum']
 494    set I3, 3.0
 495 lp:
 496    add P2, P0, P1
 497    set S0, P2
 498    print S0
 499    print " "
 500    typeof S1, P2
 501    say S1
 502    add P1, $b
 503    dec I3
 504    if I3, lp
 505    say "ok"
 506 ex:
 507    end
 508 CODE
 509 $c Integer
 510 $d BigInt
 511 $e BigInt
 512 ok
 513 OUT
 514 }
 515
 516 pasm_output_is( <<'CODE', <<'OUT', "abs", @todo_str );
 517    new P0, ['BigNum']
 518    set P0, "-1230000000000"
 519    new P1, ['Undef']
 520    abs P1, P0
 521    say P1
 522    say P0
 523    abs P0
 524    say P0
 525    end
 526 CODE
 527 1230000000000
 528 -1230000000000
 529 1230000000000
 530 OUT
 531
 532 pir_output_is( << 'CODE', << 'OUTPUT', "check whether interface is done" );
 533
 534 .sub _main
 535     .local pmc pmc1
 536     pmc1 = new ['BigNum']
 537     .local int bool1
 538     does bool1, pmc1, "scalar"
 539     say bool1
 540     does bool1, pmc1, "no_interface"
 541     say bool1
 542     end
 543 .end
 544 CODE
 545 1
 546 0
 547 OUTPUT
 548
 549 pasm_output_is( <<"CODE", <<'OUTPUT', "Truth" );
 550      new P0, ['BigNum']
 551      set P0, "123456789123456789"
 552      if P0, OK1
 553      print "not "
 554 OK1: say "ok 1"
 555      set P0, 0
 556      unless P0, OK2
 557      print "not "
 558 OK2: say "ok 2"
 559      end
 560 CODE
 561 ok 1
 562 ok 2
 563 OUTPUT
 564
 565 pasm_output_is( <<"CODE", <<'OUTPUT', "neg" );
 566      new P0, ['BigNum']
 567      new P1, ['BigNum']
 568      set P0, "123456789123456789"
 569      neg P0
 570      set P1, "-123456789123456789"
 571      eq P0, P1, OK1
 572      print "not "
 573 OK1: say "ok 1"
 574      end
 575 CODE
 576 ok 1
 577 OUTPUT
 578
 579 pir_output_is( <<'CODE', <<'OUT', "BUG #34949 gt" );
 580 .sub main :main
 581     .local pmc b
 582     b = new ['BigNum']
 583     b = 1e10
 584     if b > 4 goto ok
 585     say "never"
 586     end
 587 ok:
 588     say "ok"
 589 .end
 590 CODE
 591 ok
 592 OUT
 593
 594 pir_output_is( <<'CODE', <<'OUT', "BUG #34949 ge" );
 595 .sub main :main
 596     .local pmc b
 597     b = new ['BigNum']
 598     b = 1e10
 599     if b >= 4 goto ok
 600     say "never"
 601     end
 602 ok:
 603     say "ok"
 604 .end
 605 CODE
 606 ok
 607 OUT
 608
 609 pir_output_is( <<'CODE', <<'OUT', "BUG #34949 ne" );
 610 .sub main :main
 611     .local pmc b
 612     b = new ['BigNum']
 613     b = 1e10
 614     if b != 4 goto ok
 615     say "never"
 616     end
 617 ok:
 618     say "ok"
 619 .end
 620 CODE
 621 ok
 622 OUT
 623
 624 pir_output_is( <<'CODE', <<'OUT', "BUG #34949 eq" );
 625 .sub main :main
 626     .local pmc b
 627     b = new ['BigNum']
 628     b = 1e10
 629     if b == 4 goto nok
 630     say "ok"
 631     end
 632 nok:
 633     say "nok"
 634 .end
 635 CODE
 636 ok
 637 OUT
 638
 639 pir_output_is( <<'CODE', <<'OUT', "BUG #34949 le" );
 640 .sub main :main
 641     .local pmc b
 642     b = new ['BigNum']
 643     b = 1e10
 644     if b <= 4 goto nok
 645     say "ok"
 646     end
 647 nok:
 648     say "nok"
 649 .end
 650 CODE
 651 ok
 652 OUT
 653
 654 pir_output_is( <<'CODE', <<'OUT', "BUG #34949 lt" );
 655 .sub main :main
 656     .local pmc b
 657     b = new ['BigNum']
 658     b = 1e10
 659     if b < 4 goto nok
 660     say "ok"
 661     end
 662 nok:
 663     say "nok"
 664 .end
 665 CODE
 666 ok
 667 OUT
 668
 669 # Local Variables:
 670 #   mode: cperl
 671 #   cperl-indent-level: 4
 672 #   fill-column: 100
 673 # End:
 674 # vim: expandtab shiftwidth=4: