t/pmc/multidispatch.t

   1 #! perl
   2 # Copyright (C) 2001-2008, 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::Util 'create_tempfile';
  11
  12 use Parrot::Test tests => 48;
  13
  14 =head1 NAME
  15
  16 t/pmc/mmd.t - Multi-Method Dispatch
  17
  18 =head1 SYNOPSIS
  19
  20     % prove t/pmc/mmd.t
  21
  22 =head1 DESCRIPTION
  23
  24 Tests the multi-method dispatch.
  25
  26 =cut
  27
  28 pir_output_is( <<'CODE', <<'OUTPUT', 'Integer_divide_Integer  10 / 3 = 1003', todo => 'TT #452' );
  29
  30 .sub 'test' :main
  31     .local pmc divide
  32     divide = get_global "Integer_divide_Integer"
  33     add_multi "divide", "Integer,Integer,Integer", divide
  34
  35     $P0 = new ['Integer']
  36     $P1 = new ['Integer']
  37     $P2 = new ['Integer']
  38     $P1 = 10
  39     $P2 = 3
  40     $P0 = $P1 / $P2
  41     print $P0
  42     print "\n"
  43 .end
  44
  45 .sub Integer_divide_Integer
  46     .param pmc left
  47     .param pmc right
  48     .param pmc lhs
  49     $I0 = left
  50     $I1 = right
  51     $I2 = $I0/$I1     # don't call divide Integer/Integer here
  52     lhs = $I2         # '
  53     lhs += 1000  # prove that this function has been called
  54     .return(lhs)
  55 .end
  56 CODE
  57 1003
  58 OUTPUT
  59
  60 pir_output_is( <<'CODE', <<'OUTPUT', "1+1=3", todo => 'TT #452' );
  61
  62 .sub _main
  63     .local pmc add
  64     add = get_global "add"
  65     add_multi "add", "Integer,Integer,Integer", add
  66
  67     $P0 = new ['Integer']
  68     $P1 = new ['Integer']
  69     $P2 = new ['Integer']
  70     $P1 = 1
  71     $P2 = 1
  72     $P0 = $P1 + $P2
  73     print $P0
  74     print "\n"
  75 .end
  76
  77 .sub add
  78     .param pmc left
  79     .param pmc right
  80     .param pmc lhs
  81     $I0 = left
  82     $I1 = right
  83     $I2 = $I0 + $I1
  84     inc $I2
  85     lhs = $I2
  86     .return (lhs)
  87 .end
  88 CODE
  89 3
  90 OUTPUT
  91
  92 pir_output_is( <<'CODE', <<'OUTPUT', "PASM divide - override builtin 10 / 3 = 42", todo => 'TT #452' );
  93
  94 .sub _main
  95     .local pmc divide
  96     divide = get_global "Integer_divide_Integer"
  97     add_multi "divide", "Integer,Integer,Integer", divide
  98
  99     $P0 = new ['Integer']
 100     $P1 = new ['Integer']
 101     $P2 = new ['Integer']
 102     $P1 = 10
 103     $P2 = 3
 104     $P0 = $P1 / $P2
 105     print $P0
 106     print "\n"
 107 .end
 108
 109 .sub Integer_divide_Integer
 110     .param pmc left
 111     .param pmc right
 112     .param pmc lhs
 113     lhs = 42
 114     .return(lhs)
 115 .end
 116 CODE
 117 42
 118 OUTPUT
 119
 120 pir_output_is( <<'CODE', <<'OUTPUT', "INTVAL return numeq", todo => 'TT #452' );
 121
 122 .sub _main
 123     .local pmc comp
 124     comp = get_global "Float_cmp_Integer"
 125     add_multi "cmp", "Float,Integer", comp
 126
 127     $P1 = new ['Float']
 128     $P2 = new ['Integer']
 129     $P1 = 47.11
 130     $P2 = 47
 131     $I0 = cmp $P1, $P2   # XXX cmp calls cmp_num
 132     print $I0
 133     print "\n"
 134 .end
 135
 136 .sub Float_cmp_Integer
 137     .param pmc left
 138     .param pmc right
 139     .begin_return
 140     .set_return -42
 141     .end_return
 142 .end
 143 CODE
 144 -42
 145 OUTPUT
 146
 147 pir_output_is( <<'CODE', <<'OUTPUT', "find_multi" );
 148
 149 .sub _main
 150     .local pmc comp
 151     comp = get_global "Float_cmp_Integer"
 152     add_multi "cmp_num", "Float,Integer", comp
 153     $P0 = find_multi "cmp_num", "Float,Integer"
 154     if_null $P0, nok
 155     print "ok 1\n"
 156     ne_addr $P0, comp, nok
 157     print "ok 2\n"
 158     end
 159 nok:
 160     print "not ok\n"
 161 .end
 162
 163 .sub Float_cmp_Integer
 164     .param pmc left
 165     .param pmc right
 166     .begin_return
 167     .set_return -42
 168     .end_return
 169 .end
 170 CODE
 171 ok 1
 172 ok 2
 173 OUTPUT
 174
 175 pir_output_is( <<'CODE', <<'OUTPUT', "find_multi - invoke it" );
 176
 177 .sub _main
 178     .local pmc comp
 179     comp = get_global "Float_cmp_Integer"
 180     add_multi "cmp_num", "Float,Integer", comp
 181     $P0 = find_multi "cmp_num", "Float,Integer"
 182     if_null $P0, nok
 183     print "ok 1\n"
 184     ne_addr $P0, comp, nok
 185     print "ok 2\n"
 186     $P1 = new ['Float']
 187     $P2 = new ['Integer']
 188     $P1 = 47.11
 189     $P2 = 47
 190     $I0 = $P0($P1, $P2)
 191     print $I0
 192     print "\n"
 193     end
 194 nok:
 195     print "not ok\n"
 196 .end
 197 .sub Float_cmp_Integer
 198     .param pmc left
 199     .param pmc right
 200     .begin_return
 201     .set_return -42
 202     .end_return
 203 .end
 204 CODE
 205 ok 1
 206 ok 2
 207 -42
 208 OUTPUT
 209
 210 my ($TEMP, $temp_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 );
 211
 212 print $TEMP <<'EOF';
 213 .sub Integer_divide_Integer
 214     .param pmc left
 215     .param pmc right
 216     .param pmc lhs
 217     lhs = 42
 218     .return(lhs)
 219 .end
 220 EOF
 221 close $TEMP;
 222
 223 pir_output_is( <<"CODE", <<'OUTPUT', "PASM MMD divide - loaded sub", todo => 'TT #452' );
 224 .sub _main
 225     .local pmc divide
 226     load_bytecode "$temp_pir"
 227     divide = get_global "Integer_divide_Integer"
 228     add_multi "divide", "Integer,Integer,Integer", divide
 229
 230     \$P0 = new ['Integer']
 231     \$P1 = new ['Integer']
 232     \$P2 = new ['Integer']
 233     \$P1 = 10
 234     \$P2 = 3
 235     \$P0 = \$P1 / \$P2
 236     say \$P0
 237 .end
 238 CODE
 239 42
 240 OUTPUT
 241
 242 pasm_output_is( <<'CODE', <<'OUTPUT', "PASM INTVAL - new result", todo => 'TT #452' );
 243 .include "datatypes.pasm"
 244     get_global P10, "Integer_bxor_Intval"
 245     add_multi "bitwise_xor_int", "Integer,INTVAL,PMC", P10
 246
 247     new P1, ['Integer']
 248     set P1, 3
 249     bxor P9, P1, 2
 250     print P9
 251     print "\n"
 252     end
 253 .pcc_sub Integer_bxor_Intval:
 254     get_params "0,0,0", P5, I5, P6
 255     print "ok\n"
 256     set I10, P5
 257     bxor I11, I10, I5
 258     new P6, ['Integer']
 259     set P6, I11
 260     set_returns "0", P6
 261     returncc
 262 CODE
 263 ok
 264 1
 265 OUTPUT
 266
 267 pasm_output_is( <<'CODE', <<'OUTPUT', "PASM INTVAL - existing result", todo => 'TT #452' );
 268 .include "datatypes.pasm"
 269     get_global P10, "Integer_bxor_Intval"
 270     add_multi "bitwise_xor_int", "Integer,INTVAL,PMC", P10
 271
 272     new P0, ['Integer']
 273     new P1, ['Integer']
 274     set P1, 3
 275     bxor P0, P1, 2
 276     print P0
 277     print "\n"
 278     end
 279 .pcc_sub Integer_bxor_Intval:
 280     get_params "0,0,0", P5, I5, P6
 281     print "ok\n"
 282     set I10, P5
 283     bxor I11, I10, I5
 284     set P6, I11
 285     set_returns "0", P6
 286     returncc
 287 CODE
 288 ok
 289 1
 290 OUTPUT
 291
 292 pasm_output_is( <<'CODE', <<'OUTPUT', "PASM INTVAL - mixed", todo => 'TT #452' );
 293 .include "datatypes.pasm"
 294     get_global P10, "Integer_bxor_Intval"
 295     add_multi "bitwise_xor_int", "Integer,INTVAL,PMC", P10
 296
 297     new P0, ['Integer']
 298     new P1, ['Integer']
 299     set P1, 3
 300     bxor P0, P1, 2
 301     print P0
 302     print "\n"
 303     bxor P9, P1, 2
 304     print P9
 305     print "\n"
 306     end
 307 .pcc_sub Integer_bxor_Intval:
 308     get_params "0,0,0", P5, I5, P6
 309     print "ok\n"
 310     set I10, P5
 311     bxor I11, I10, I5
 312     new P6, ['Integer']
 313     set P6, I11
 314     set_returns "0", P6
 315     returncc
 316
 317 CODE
 318 ok
 319 1
 320 ok
 321 1
 322 OUTPUT
 323
 324 pir_output_is( <<'CODE', <<'OUT', "first dynamic MMD call" );
 325
 326 .sub main :main
 327     .local pmc F, B, f, b, m, s
 328     newclass F, "Foo"
 329     f = new ['Foo']
 330     newclass B, "Bar"
 331     b = new ['Bar']
 332     # create a multi the hard way
 333     ## m = new MultiSub
 334     ## s = get_global "Foo", "foo"
 335     ## push m, s
 336     ## s = get_global "Bar", "foo"
 337     ## push m, s
 338     ## set_global "foo", m
 339     print "calling foo(f, b)\n"
 340     foo(f, b)
 341     print "calling foo(b, f)\n"
 342     foo(b, f)
 343 .end
 344
 345 .sub foo :multi(Foo, Bar)
 346     .param pmc x
 347     .param pmc y
 348     print "  Foo::foo\n"
 349 .end
 350
 351 .sub foo :multi(Bar, Foo)
 352     .param pmc x
 353     .param pmc y
 354     print "  Bar::foo\n"
 355 .end
 356 CODE
 357 calling foo(f, b)
 358   Foo::foo
 359 calling foo(b, f)
 360   Bar::foo
 361 OUT
 362
 363 pir_output_is( <<'CODE', <<'OUT', "MMD second arg int/float dispatch" );
 364 .sub foo :multi(_, Integer)
 365     .param pmc first
 366     .param pmc second
 367     print "(_, Int) method:  "
 368     print first
 369     print ', '
 370     print second
 371     print "\n"
 372 .end
 373 .sub foo :multi(_, Float)
 374     .param pmc first
 375     .param pmc second
 376     print "(_, Float) method:  "
 377     print first
 378     print ', '
 379     print second
 380     print "\n"
 381 .end
 382 .sub main :main
 383     $P0 = new ['Float']
 384     $P0 = 9.5
 385     foo(1, $P0)
 386     $P1 = new ['Integer']
 387     $P1 = 3
 388     foo(1, $P1)
 389 .end
 390 CODE
 391 (_, Float) method:  1, 9.5
 392 (_, Int) method:  1, 3
 393 OUT
 394
 395 pir_error_output_like( <<'CODE', <<'OUT', "MMD single method, dispatch failure" );
 396 ## Compare this to the previous example.
 397 .sub foo :multi(_, Float)
 398     .param pmc first
 399     .param pmc second
 400     print "(_, Float) method:  "
 401     print first
 402     print ', '
 403     print second
 404     print "\n"
 405 .end
 406 .sub main :main
 407     $P0 = new ['Float']
 408     $P0 = 9.5
 409     foo(1, $P0)
 410     $P1 = new ['Integer']
 411     $P1 = 3
 412     foo(1, $P1)
 413 .end
 414 CODE
 415 /\A\(_, Float\) method:  1, 9\.5
 416 No applicable methods/
 417 OUT
 418
 419 pir_output_is( <<'CODE', <<'OUT', "MMD on argument count" );
 420 .sub main :main
 421     p("ok 1\n")
 422     p("-twice", "ok 2\n")
 423 .end
 424
 425 .sub p :multi(string)
 426     .param string s
 427     print s
 428 .end
 429
 430 .sub p :multi(string, string)
 431     .param string opt
 432     .param string s
 433     if opt != '-twice' goto no_twice
 434     print s
 435     print s
 436     .return()
 437 no_twice:
 438     print s
 439 .end
 440 CODE
 441 ok 1
 442 ok 2
 443 ok 2
 444 OUT
 445
 446 pir_output_is( <<'CODE', <<'OUT', "MMD on native types" );
 447 .sub main :main
 448     p("ok 1\n")
 449     p(42)
 450 .end
 451
 452 .sub p :multi(string)
 453     .param string s
 454     print s
 455 .end
 456
 457 .sub p :multi(int)
 458     .param int i
 459     print i
 460     print "\n"
 461 .end
 462 CODE
 463 ok 1
 464 42
 465 OUT
 466
 467 pir_output_is( <<'CODE', <<'OUT', 'MMD on PMC types' );
 468 .sub 'test' :main
 469     $P0 = new ['String']
 470     $P0 = "ok 1\n"
 471     p($P0)
 472
 473     .local pmc pstring
 474     pstring = subclass 'String', 'PString'
 475     $P1 = new ['PString']
 476     $P1 = "ok 2\n"
 477     p($P1)
 478
 479     $P0 = subclass 'PString', "Xstring"
 480     $P0 = new ['Xstring']
 481     $P0 = "ok 3\n"
 482     $P1 = subclass 'String', "Ystring"
 483     $P1 = new ['Ystring']
 484     $P1 = "ok 4\n"
 485     p($P0)
 486     p($P1)
 487 .end
 488
 489 .sub p :multi(PString)
 490     .param pmc p
 491     print "PSt "
 492     print p
 493 .end
 494
 495 .sub p :multi(String)
 496     .param pmc p
 497     print "String "
 498     print p
 499 .end
 500 CODE
 501 String ok 1
 502 PSt ok 2
 503 PSt ok 3
 504 String ok 4
 505 OUT
 506
 507 pir_output_is( <<'CODE', <<'OUT', 'MMD on PMC types quoted' );
 508 .sub main :main
 509     $P0 = new ['String']
 510     $P0 = "ok 1\n"
 511     p($P0)
 512
 513     .local pmc pstring
 514     pstring = subclass 'String', 'PString'
 515     $P1 = new ['PString']
 516     $P1 = "ok 2\n"
 517     p($P1)
 518
 519     $P0 = subclass "PString", "Xstring"
 520     $P0 = new ['Xstring']
 521     $P0 = "ok 3\n"
 522     $P1 = subclass "String", "Ystring"
 523     $P1 = new ['Ystring']
 524     $P1 = "ok 4\n"
 525     p($P0)
 526     p($P1)
 527 .end
 528
 529 .sub p :multi("String")
 530     .param pmc p
 531     print "String "
 532     print p
 533 .end
 534
 535 .sub p :multi("PString")
 536     .param pmc p
 537     print "PSt "
 538     print p
 539 .end
 540 CODE
 541 String ok 1
 542 PSt ok 2
 543 PSt ok 3
 544 String ok 4
 545 OUT
 546
 547 pir_error_output_like( <<'CODE', <<'OUT', 'MMD on PMC types, invalid' );
 548 .sub main :main
 549     $P0 = new ['String']
 550     $P0 = "ok 1\n"
 551     p($P0)
 552
 553     .local pmc pstring
 554     pstring = subclass 'String', 'PString'
 555     $P1 = new ['PString']
 556     $P1 = "ok 2\n"
 557     p($P1)
 558     $P0 = subclass "PString", "Xstring"
 559     $P0 = new ['Xstring']
 560     $P0 = "ok 3\n"
 561     $P1 = subclass "String", "Ystring"
 562     $P1 = new ['Ystring']
 563     $P1 = "ok 4\n"
 564     p($P0)
 565     p($P1)
 566     $P0 = new ['Integer']
 567     p($P0)
 568 .end
 569
 570 .sub p :multi(String)
 571     .param pmc p
 572     print "String "
 573     print p
 574 .end
 575
 576 .sub p :multi(PString)
 577     .param pmc p
 578     print "PSt "
 579     print p
 580 .end
 581 CODE
 582 /String ok 1
 583 PSt ok 2
 584 PSt ok 3
 585 String ok 4
 586 No applicable methods/
 587 OUT
 588
 589 pir_output_is( <<'CODE', <<'OUT', 'MMD on PMC types 3' );
 590 .sub main :main
 591     $P0 = new ['String']
 592     $P0 = "ok 1\n"
 593     p($P0)
 594
 595     .local pmc pstring
 596     pstring = subclass 'String', 'PString'
 597     $P1 = new ['PString']
 598     $P1 = "ok 2\n"
 599     p($P1)
 600
 601     $P0 = subclass "PString", "Xstring"
 602     $P0 = new ['Xstring']
 603     $P0 = "ok 3\n"
 604     $P1 = subclass "String", "Ystring"
 605     $P1 = new ['Ystring']
 606     $P1 = "ok 4\n"
 607     p($P0)
 608     p($P1)
 609
 610     .local pmc pint
 611     pint = subclass 'Integer', 'PInt'
 612     $P0 = new ['PInt']
 613     $P0 = 42
 614     p($P0)
 615 .end
 616
 617 .sub p :multi(String)
 618     .param pmc p
 619     print "String "
 620     print p
 621 .end
 622
 623 .sub p :multi(PString)
 624     .param pmc p
 625     print "PSt "
 626     print p
 627 .end
 628
 629 .sub p :multi(Integer)
 630     .param pmc p
 631     print "Intege "
 632     print p
 633     print "\n"
 634 .end
 635
 636 CODE
 637 String ok 1
 638 PSt ok 2
 639 PSt ok 3
 640 String ok 4
 641 Intege 42
 642 OUT
 643
 644 pir_output_is( <<'CODE', <<'OUT', 'MMD on PMC types, global namespace' );
 645 .sub main :main
 646     $P0 = new ['String']
 647     $P0 = "ok 1\n"
 648     p($P0)
 649
 650     .local pmc pstring
 651     pstring = subclass 'String', 'PString'
 652     $P1 = new ['PString']
 653     $P1 = "ok 2\n"
 654     p($P1)
 655
 656     $P0 = subclass "PString", "Xstring"
 657     $P0 = new ['Xstring']
 658     $P0 = "ok 3\n"
 659     $P1 = subclass "String", "Ystring"
 660     $P1 = new ['Ystring']
 661     $P1 = "ok 4\n"
 662     p($P0)
 663     p($P1)
 664 .end
 665
 666 .sub p :multi(String)
 667     .param pmc p
 668     print "String "
 669     print p
 670 .end
 671
 672 .sub p :multi(PString)
 673     .param pmc p
 674     print "PSt "
 675     print p
 676 .end
 677 CODE
 678 String ok 1
 679 PSt ok 2
 680 PSt ok 3
 681 String ok 4
 682 OUT
 683
 684 pir_output_is( <<'CODE', <<'OUT', 'MMD on PMC types, package namespace' );
 685 .namespace ["Some"]
 686
 687 .sub main :main
 688     $P0 = new ['String']
 689     $P0 = "ok 1\n"
 690     p($P0)
 691
 692     .local pmc pstring
 693     pstring = subclass 'String', 'PString'
 694     $P1 = new ['PString']
 695     $P1 = "ok 2\n"
 696     p($P1)
 697
 698     $P0 = subclass "PString", "Xstring"
 699     $P0 = new ['Xstring']
 700     $P0 = "ok 3\n"
 701     $P1 = subclass "String", "Ystring"
 702     $P1 = new ['Ystring']
 703     $P1 = "ok 4\n"
 704     p($P0)
 705     p($P1)
 706 .end
 707
 708 .sub p :multi(String)
 709     .param pmc p
 710     print "String "
 711     print p
 712 .end
 713
 714 .sub p :multi(PString)
 715     .param pmc p
 716     print "PSt "
 717     print p
 718 .end
 719 CODE
 720 String ok 1
 721 PSt ok 2
 722 PSt ok 3
 723 String ok 4
 724 OUT
 725
 726 pir_output_is( <<'CODE', <<'OUT', "MMD on PMC types - Any", todo => 'RT #41374' );
 727
 728 .sub main :main
 729     $P0 = new ['String']
 730     $P0 = "ok 1\n"
 731     $P1 = new ['PerlInt']
 732     $P1 = "ok 2\n"
 733     p($P0)
 734     p($P1)
 735     $P0 = new ['PerlInt']
 736     $P0 = 42
 737     p($P0)
 738     $P0 = new ['PerlInt']
 739     $P0 = 43
 740     q($P0)
 741 .end
 742
 743 .namespace []
 744
 745 .sub p :multi(String)
 746     .param pmc p
 747     print "String "
 748     print p
 749 .end
 750
 751 .sub p :multi(PString)
 752     .param pmc p
 753     print "PSt "
 754     print p
 755 .end
 756
 757 .sub p :multi(_)
 758     .param pmc p
 759     print "Any    "
 760     print p
 761     print "\n"
 762 .end
 763
 764 .sub q :multi(pmc)
 765     .param pmc p
 766     print "Any    "
 767     print p
 768     print "\n"
 769 .end
 770
 771 CODE
 772 String ok 1
 773 PSt ok 2
 774 Any    42
 775 Any    43
 776 OUT
 777
 778 pir_output_is( <<'CODE', <<'OUTPUT', "add as function - Int, Float" );
 779 .sub main :main
 780     .local pmc d, l, r, a
 781     d = new ['Integer']
 782     l = new ['Integer']
 783     r = new ['Float']
 784     l = 3
 785     r = 39.42
 786     a = get_root_global ["MULTI"], "add"
 787     d = a(l, r, d)
 788     print d
 789     print "\n"
 790     end
 791 .end
 792 CODE
 793 42.42
 794 OUTPUT
 795
 796 pir_output_is( <<'CODE', <<'OUTPUT', "add as method" );
 797 .sub main :main
 798     .local pmc d, l, r
 799     l = new ['Integer']
 800     r = new ['Integer']
 801     l = 3
 802     r = 39
 803     d = l."add"(r, d)
 804     print d
 805     print "\n"
 806     end
 807 .end
 808 CODE
 809 42
 810 OUTPUT
 811
 812 pir_output_is( <<'CODE', <<'OUTPUT', "add as method - inherited", todo => 'RT #41374' );
 813 .sub main :main
 814     .local pmc d, l, r
 815     .local pmc pint
 816     pint = subclass 'Integer', 'PInt'
 817     l = new ['PInt']
 818     r = new ['PInt']
 819     l = 3
 820     r = 39
 821     d = l."add"(r, d)
 822     print d
 823     print "\n"
 824 .end
 825 CODE
 826 42
 827 OUTPUT
 828
 829 pir_output_is( <<'CODE', <<'OUTPUT', "add as method - Int, Float" );
 830 .sub main :main
 831     .local pmc d, l, r
 832     l = new ['Integer']
 833     r = new ['Float']
 834     l = 3
 835     r = 39.42
 836     d = l."add"(r, d)
 837     print d
 838     print "\n"
 839     end
 840 .end
 841 CODE
 842 42.42
 843 OUTPUT
 844
 845 pir_output_is( <<'CODE', <<'OUTPUT', "bound add method" );
 846 .sub main :main
 847     .local pmc d, l, r, m
 848     d = new ['Integer']
 849     l = new ['Integer']
 850     r = new ['Float']
 851     l = 3
 852     r = 39.42
 853     m = get_global ['scalar'], "add"
 854     d = m(r, l, d)
 855     print d
 856     print "\n"
 857     r = new ['Integer']
 858     r = 39
 859     m = get_global ['Integer'], "add"
 860     d = m(r, l, d)
 861     print d
 862     print "\n"
 863     end
 864 .end
 865 CODE
 866 42.42
 867 42
 868 OUTPUT
 869
 870 pir_output_is( <<'CODE', <<'OUTPUT', "Integer subclasses" );
 871 .sub main :main
 872     .local pmc d, l, r, cl
 873     cl = subclass "Integer", "AInt"
 874     d = new ['AInt']
 875     l = new ['AInt']
 876     r = new ['AInt']
 877     l = 4
 878     r = 38
 879     print l
 880     print "\n"
 881     print r
 882     print "\n"
 883     # dispatches to Parrot_Integer_add_Integer
 884     add d, l, r
 885     print d
 886     print "\n"
 887     add l, r
 888     print l
 889     print "\n"
 890 .end
 891
 892 CODE
 893 4
 894 38
 895 42
 896 42
 897 OUTPUT
 898
 899 pir_output_is( <<'CODE', <<'OUTPUT', "Integer subclasses, add" );
 900 .sub main :main
 901     $P0 = subclass "Integer", "AInt"
 902     $P0 = new ['AInt']
 903     $P1 = new ['Integer']
 904     set $P0, 6
 905     set $P1, 2
 906
 907     $P2 = add  $P0, $P1
 908     print $P2
 909     print "\n"
 910 .end
 911 .namespace ["AInt"]
 912 .sub add :multi(AInt, Integer, PMC)
 913     .param pmc l
 914     .param pmc r
 915     .param pmc d
 916     print l
 917     print r
 918     print "\n"
 919     d = new ['Integer']
 920     d = 2
 921     .return(d)
 922 .end
 923 CODE
 924 62
 925 2
 926 OUTPUT
 927
 928 ($TEMP, $temp_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 );
 929
 930 print $TEMP <<'EOF';
 931 .namespace ["AInt"]
 932 .sub add :multi(AInt, Integer, PMC)
 933     .param pmc l
 934     .param pmc r
 935     .param pmc d
 936     print l
 937     print r
 938     print "\n"
 939     d = new ['Integer']
 940     d = 2
 941     .return(d)
 942 .end
 943 EOF
 944 close $TEMP;
 945
 946 pir_output_is( <<"CODE", <<'OUTPUT', "override builtin add" );
 947 .sub main
 948     load_bytecode "$temp_pir"
 949     \$P0 = subclass "Integer", "AInt"
 950     \$P0 = new ['AInt']
 951     \$P1 = new ['Integer']
 952     set \$P0, 6
 953     set \$P1, 2
 954
 955     \$P2 = add \$P0, \$P1
 956     say \$P2
 957 .end
 958 CODE
 959 62
 960 2
 961 OUTPUT
 962
 963 pir_output_is( <<'CODE', <<'OUTPUT', "mmd bug reported by Jeff" );
 964 .namespace ['Foo']
 965
 966 .sub bar :method :multi(Foo, string)
 967     .param string arg
 968     print "string\n"
 969 .end
 970
 971 .sub bar :method :multi(Foo, pmc)
 972     .param pmc arg
 973     print "PMC\n"
 974 .end
 975
 976 .sub bar :method :multi(Foo)
 977     print "nothing\n"
 978 .end
 979
 980 .namespace []
 981
 982 .sub main :main
 983     newclass $P0, 'Foo'
 984
 985     $P0 = new ['Foo']
 986
 987     $P0.'bar'('Bar!')
 988
 989     $P1 = new ['String']
 990     $P1 = "Bar!"
 991     $P0.'bar'($P1)
 992
 993     $P0.'bar'()
 994 .end
 995 CODE
 996 string
 997 PMC
 998 nothing
 999 OUTPUT
1000
1001 pir_output_is( <<'CODE', <<'OUTPUT', "use a core func for an object", todo => 'RT #59628' );
1002 .sub main :main
1003     .local pmc d, l, r, cl
1004     cl = newclass "AInt"
1005     addattribute cl, ".i"
1006     d = new ['AInt']
1007     l = new ['AInt']
1008     r = new ['AInt']
1009     .local pmc func
1010     .local string typ
1011     func = find_multi "add", "Float,Float,PMC"
1012     $S0 = typeof l
1013     typ = $S0 . ","
1014     typ .= $S0
1015     typ .= ","
1016     typ .= $S0
1017     add_multi "add", typ, func
1018     l = 4
1019     r = 38
1020     print l
1021     print "\n"
1022     print r
1023     print "\n"
1024     add d, l, r
1025     print d
1026     print "\n"
1027 .end
1028 .namespace ["AInt"]
1029 .sub init :vtable :method
1030     $P0 = new ['Integer']
1031     setattribute self, ".i", $P0
1032 .end
1033 .sub set_integer_native :vtable :method
1034     .param int i
1035     $P0 = getattribute self, ".i"
1036     $P0 = i
1037 .end
1038 .sub set_number_native :vtable :method
1039     .param num f
1040     $P0 = getattribute self, ".i"
1041     $P0 = f
1042 .end
1043 .sub get_string :vtable :method
1044     $P0 = getattribute self, ".i"
1045     $S0 = $P0
1046     .return ($S0)
1047 .end
1048 .sub get_number :vtable :method
1049     $P0 = getattribute self, ".i"
1050     $N0 = $P0
1051     .return ($N0)
1052 .end
1053 CODE
1054 4
1055 38
1056 42
1057 OUTPUT
1058
1059 pir_output_is( <<'CODE', <<'OUTPUT', "multisub vs find_name" );
1060 .sub main :main
1061     $P0 = find_name "foo"
1062     $S0 = typeof $P0
1063     print $S0
1064     print "\n"
1065 .end
1066 .sub foo :method :multi(string)
1067     .param pmc x
1068     print "  foo\n"
1069 .end
1070 .sub foo :method :multi(pmc)
1071     .param pmc x
1072     print "  foo\n"
1073 .end
1074 CODE
1075 MultiSub
1076 OUTPUT
1077
1078 pir_output_is( <<'CODE', <<'OUTPUT', "multisub w void" );
1079 .sub main :main
1080     foo('xx')
1081     foo()
1082     foo('xx')
1083 .end
1084 .sub foo :multi(string)
1085     .param pmc x
1086     print "foo string\n"
1087 .end
1088 .sub foo :multi()
1089     print "foo\n"
1090 .end
1091 CODE
1092 foo string
1093 foo
1094 foo string
1095 OUTPUT
1096
1097 pir_output_is( <<'CODE', <<'OUTPUT', "multisub w/o .HLL" );
1098 .sub main :main
1099     $P0 = new ['Integer']
1100     $P0 = 3
1101     $P9 = 'foo'($P0)
1102
1103     $P0 = new ['ResizablePMCArray']
1104     push $P0, 4
1105     $P1 = new ['String']
1106     $P1 = 'hello'
1107     $P9 = 'foo'($P0, $P1)
1108 .end
1109
1110 .sub 'foo' :multi(Integer)
1111     print "foo(Integer)\n"
1112     .return (0)
1113 .end
1114
1115 .sub 'foo' :multi(ResizablePMCArray, _)
1116     print "foo(ResizablePMCArray,_)\n"
1117     .return (0)
1118 .end
1119 CODE
1120 foo(Integer)
1121 foo(ResizablePMCArray,_)
1122 OUTPUT
1123
1124 pir_output_is( <<'CODE', <<'OUTPUT', "multisub w/ .HLL, rt #39161" );
1125 .HLL 'Perl6'
1126 .sub main :main
1127     $P0 = new ['Integer']
1128     $P0 = 3
1129     $P9 = 'foo'($P0)
1130
1131     $P0 = new ['ResizablePMCArray']
1132     push $P0, 4
1133     $P1 = new ['String']
1134     $P1 = 'hello'
1135     $P9 = 'foo'($P0, $P1)
1136 .end
1137
1138 .sub 'foo' :multi(Integer)
1139     print "foo(Integer)\n"
1140     .return (0)
1141 .end
1142
1143 .sub 'foo' :multi(ResizablePMCArray, _)
1144     print "foo(ResizablePMCArray,_)\n"
1145     .return (0)
1146 .end
1147 CODE
1148 foo(Integer)
1149 foo(ResizablePMCArray,_)
1150 OUTPUT
1151
1152 pir_output_is( <<'CODE', <<'OUTPUT', "multisub w/ flatten" );
1153 # see also 'rt #39173
1154 .sub main :main
1155     .local pmc int_pmc
1156     int_pmc = new ['Integer']
1157     int_pmc = 3
1158
1159     .local pmc args
1160     args = new ['ResizablePMCArray']
1161     push args, int_pmc
1162     'foo'( args :flat )
1163
1164     .local pmc string_pmc
1165     string_pmc = new ['String']
1166     string_pmc = 'hello'
1167
1168     args = new ['ResizablePMCArray']
1169     push args, string_pmc
1170     'foo'( args :flat )
1171     end
1172 .end
1173
1174 .sub 'foo' :multi(Integer)
1175     print "foo(Integer)\n"
1176 .end
1177
1178 .sub 'foo' :multi(String)
1179     print "foo(String)\n"
1180 .end
1181 CODE
1182 foo(Integer)
1183 foo(String)
1184 OUTPUT
1185
1186 pir_output_is( <<'CODE', <<'OUTPUT', "keyed class name and multi" );
1187 .sub main :main
1188     .local pmc class
1189     newclass class, [ 'Some'; 'Class' ]
1190
1191     .local pmc instance
1192     instance = new [ 'Some'; 'Class' ]
1193
1194     .local string name
1195     name = typeof instance
1196
1197     print "Type: "
1198     print name
1199     print "\n"
1200     end
1201 .end
1202 CODE
1203 Type: Some;Class
1204 OUTPUT
1205
1206 pir_output_is( <<'CODE', <<'OUTPUT', "keyed class name and multi" );
1207 .sub main :main
1208     .local pmc class
1209     newclass class, [ 'Some'; 'Class' ]
1210
1211     .local pmc instance
1212     instance = new [ 'Some'; 'Class' ]
1213
1214     foo( instance )
1215     end
1216 .end
1217
1218 .sub 'foo' :multi( [ 'Some'; 'Class' ])
1219     print "Called multi for class\n"
1220 .end
1221
1222 .sub 'foo' :multi(_)
1223     print "Called wrong multi\n"
1224 .end
1225 CODE
1226 Called multi for class
1227 OUTPUT
1228
1229 pir_output_is( <<'CODE', <<'OUTPUT', "unicode sub names and multi (RT #39254)" );
1230 .sub unicode:"\u7777" :multi(string)
1231   .param pmc arg
1232   print 'String:'
1233   say arg
1234 .end
1235 .sub unicode:"\u7777" :multi(int)
1236   .param pmc arg
1237   print 'Int:'
1238   say arg
1239 .end
1240
1241 .sub main :main
1242   unicode:"\u7777"('what')
1243   unicode:"\u7777"(23)
1244 .end
1245 CODE
1246 String:what
1247 Int:23
1248 OUTPUT
1249
1250 pir_output_is( <<'CODE', <<'OUTPUT', "autoboxing on multis" );
1251 .sub box_me_up :multi(string)
1252     .param string first
1253     .param pmc    second
1254
1255     .local string promoted_type
1256     promoted_type = typeof second
1257     print "BMU autobox type: "
1258     print promoted_type
1259     print "\n"
1260 .end
1261
1262 .sub box_me_up :multi()
1263     print "BMU no autobox, so sad\n"
1264 .end
1265
1266 .sub box_me_up :multi(int, int)
1267     print "BMU inty, so bad\n"
1268 .end
1269
1270 .sub main :main
1271     box_me_up( 'foo', 'bar' )
1272 .end
1273 CODE
1274 BMU autobox type: String
1275 OUTPUT
1276
1277 pir_output_is( <<'CODE', <<'OUTPUT', '_ matches native types' );
1278 .sub main :main
1279   .local pmc asub
1280   asub = get_global 'main'
1281
1282   foo('world', asub) # should call :multi(_, Sub)
1283 .end
1284
1285 .sub foo :multi(_, Sub)
1286   .param pmc x
1287   .param pmc y
1288   print x
1289   print " "
1290   say ":multi(_, Sub)"
1291 .end
1292
1293 .sub foo :multi(Integer, Sub)
1294   .param int x
1295   .param pmc y
1296   print x
1297   print " "
1298   say ":multi(int, Sub)"
1299 .end
1300 CODE
1301 world :multi(_, Sub)
1302 OUTPUT
1303
1304 pir_output_is( <<'CODE', <<'OUTPUT', 'type mix with _' );
1305 .sub main :main
1306     $P0 = new ['Integer']
1307     $P0 = 3
1308     'foo'($P0)
1309     'foo'(2)
1310     'foo'("1")
1311     $P0 = new ['String']
1312     $P0 = "0"
1313     'foo'($P0)
1314     $P0 = new ['Hash']
1315     'foo'($P0)
1316 .end
1317
1318 .sub 'foo' :multi(Integer)
1319     .param pmc i
1320     print "foo(Integer)\n"
1321 .end
1322
1323 .sub 'foo' :multi(_)
1324     .param pmc i
1325     print "foo(_)\n"
1326 .end
1327
1328 .sub 'foo' :multi(int)
1329     .param int i
1330     print "foo(int)\n"
1331 .end
1332
1333 .sub 'foo' :multi(String)
1334     .param pmc i
1335     print "foo(String)\n"
1336 .end
1337
1338 .sub 'foo' :multi(string)
1339     .param string i
1340     print "foo(string)\n"
1341 .end
1342 CODE
1343 foo(Integer)
1344 foo(int)
1345 foo(string)
1346 foo(String)
1347 foo(_)
1348 OUTPUT
1349
1350 pir_output_is( <<'CODE', <<'OUTPUT', ':multi with :outer' );
1351 .sub main :main
1352     new $P0, ['String']
1353     assign $P0, 'arg0'
1354     new $P1, ['String']
1355     assign $P1, 'arg1'
1356
1357     $P99 = "foo"($P0)
1358
1359     $P99 = "foo"($P0, $P1)
1360
1361     $P99 = "bar"($P0)
1362
1363     $P99 = "bar"($P0, $P1)
1364 .end
1365
1366
1367 .sub "foo" :multi(_)
1368     .param pmc x
1369     print "foo(_)  : "
1370     say x
1371     .return (x)
1372 .end
1373
1374 .sub "foo" :multi(_,_)
1375     .param pmc x
1376     .param pmc y
1377     print "foo(_,_): "
1378     print x
1379     print " "
1380     say y
1381     .return (y)
1382 .end
1383
1384 .sub "bar" :outer("main") :multi(_)
1385     .param pmc x
1386     print "bar(_)  : "
1387     say x
1388     .return (x)
1389 .end
1390
1391 .sub "bar" :outer("main") :multi(_,_)
1392     .param pmc x
1393     .param pmc y
1394     print "bar(_,_): "
1395     print x
1396     print " "
1397     say y
1398     .return (y)
1399 .end
1400 CODE
1401 foo(_)  : arg0
1402 foo(_,_): arg0 arg1
1403 bar(_)  : arg0
1404 bar(_,_): arg0 arg1
1405 OUTPUT
1406
1407 pir_output_is( <<'CODE', <<'OUTPUT', "multi-dispatch on PMCNULL" );
1408
1409 .sub main :main
1410     null $P0
1411     foo($P0)
1412 .end
1413 .sub foo :multi(String)
1414     say "string"
1415 .end
1416 .sub foo :multi(_)
1417     say "any"
1418 .end
1419 CODE
1420 any
1421 OUTPUT
1422
1423 pir_output_is( <<'CODE', <<'OUTPUT', "multi-dispatch with :optional" );
1424
1425 .sub 'main' :main
1426     foo('Hello')
1427     foo('Goodbye', 2)
1428     foo(1)
1429     foo(100, 200)
1430 .end
1431
1432 .sub foo :multi(string)
1433     .param string s
1434     .param int    i      :optional
1435     .param int    have_i :opt_flag
1436
1437     say s
1438     unless have_i goto done
1439     say i
1440   done:
1441 .end
1442
1443 .sub foo :multi(int)
1444     .param int x
1445     .param int i      :optional
1446     .param int have_i :opt_flag
1447
1448     say x
1449     unless have_i goto done
1450     say i
1451   done:
1452 .end
1453 CODE
1454 Hello
1455 Goodbye
1456 2
1457 1
1458 100
1459 200
1460 OUTPUT
1461
1462 pir_output_is( <<'CODE', <<'OUTPUT', '.autoboxed MMD with :optional' );
1463
1464 .sub 'main' :main
1465     foo('Hello')
1466     foo('Goodbye', 2)
1467     foo(1)
1468     foo(100, 200)
1469     foo(77.7)
1470     foo(77.7, 88.8)
1471 .end
1472
1473 .sub foo :multi(String)
1474     .param pmc s
1475     .param pmc i      :optional
1476     .param int have_i :opt_flag
1477
1478     say s
1479     unless have_i goto done
1480     say i
1481   done:
1482 .end
1483
1484 .sub foo :multi(Integer)
1485     .param pmc x
1486     .param pmc i      :optional
1487     .param int have_i :opt_flag
1488
1489     say x
1490     unless have_i goto done
1491     say i
1492   done:
1493 .end
1494
1495 .sub foo :multi(Float)
1496     .param pmc x
1497     .param pmc i      :optional
1498     .param int have_i :opt_flag
1499
1500     say x
1501     unless have_i goto done
1502     say i
1503   done:
1504 .end
1505 CODE
1506 Hello
1507 Goodbye
1508 2
1509 1
1510 100
1511 200
1512 77.7
1513 77.7
1514 88.8
1515 OUTPUT
1516
1517 pir_output_is( <<'CODE', <<'OUTPUT', 'more .autoboxed MMD with :optional' );
1518
1519 .sub 'main' :main
1520     foo('Hello', 'Hi')
1521     foo('Goodbye', 'Ta ta', 2)
1522     foo(1, 2)
1523     foo(100, 200, 400)
1524     foo(77.7, 88.8)
1525     foo(77.7, 88.8, 99.9)
1526 .end
1527
1528 .sub foo :multi(String, String)
1529     .param pmc x
1530     .param pmc y
1531     .param pmc i      :optional
1532     .param int have_i :opt_flag
1533
1534     print x
1535     print y
1536     unless have_i goto done
1537     print i
1538   done:
1539     say ''
1540 .end
1541
1542 .sub foo :multi(Integer, Integer)
1543     .param pmc x
1544     .param pmc y
1545     .param pmc i      :optional
1546     .param int have_i :opt_flag
1547
1548     print x
1549     print y
1550     unless have_i goto done
1551     print i
1552   done:
1553     say ''
1554 .end
1555
1556 .sub foo :multi(Float, Float)
1557     .param pmc x
1558     .param pmc y
1559     .param pmc i      :optional
1560     .param int have_i :opt_flag
1561
1562     print x
1563     print y
1564     unless have_i goto done
1565     print i
1566   done:
1567     say ''
1568 .end
1569 CODE
1570 HelloHi
1571 GoodbyeTa ta2
1572 12
1573 100200400
1574 77.788.8
1575 77.788.899.9
1576 OUTPUT
1577
1578 # Local Variables:
1579 #   mode: cperl
1580 #   cperl-indent-level: 4
1581 #   fill-column: 100
1582 # End:
1583 # vim: expandtab shiftwidth=4: