t/pmc/multidispatch.t

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