t/pmc/object-meths.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 use Test::More;
   9 use Parrot::Test tests => 36;
  10
  11 =head1 NAME
  12
  13 t/pmc/object-meths.t - Object Methods
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/pmc/object-meths.t
  18
  19 =head1 DESCRIPTION
  20
  21 Tests PMC object methods.
  22
  23 =cut
  24
  25 pasm_error_output_like( <<'CODE', <<'OUTPUT', "callmethodcc - unknown method" );
  26     newclass P2, "Foo"
  27     set S0, "nada"
  28     callmethodcc P2, S0
  29     print "should never reach here\n"
  30     end
  31 CODE
  32 /Method 'nada' not found for invocant of class 'Foo'/
  33 OUTPUT
  34
  35 pasm_error_output_like( <<'CODE', <<'OUTPUT', "callmethod (STR) - unknown method" );
  36     newclass P2, "Foo"
  37     set S1, "nada"
  38     callmethod P2, S1, P1
  39     print "should never reach here\n"
  40     end
  41 CODE
  42 /Method 'nada' not found for invocant of class 'Foo'/
  43 OUTPUT
  44
  45 pasm_error_output_like( <<'CODE', <<'OUTPUT', "callmethodcc - unknown method" );
  46     newclass P2, "Foo"
  47     set S0, "nada"
  48     callmethodcc P2, S0
  49     print "should never reach here\n"
  50     end
  51 CODE
  52 /Method 'nada' not found for invocant of class 'Foo'/
  53 OUTPUT
  54
  55 pasm_error_output_like( <<'CODE', <<'OUTPUT', "callmethodcc (STR) - unknown method" );
  56     newclass P2, "Foo"
  57     set S1, "nada"
  58     callmethodcc P2, S1
  59     print "should never reach here\n"
  60     end
  61 CODE
  62 /Method 'nada' not found for invocant of class 'Foo'/
  63 OUTPUT
  64
  65 pir_output_is( <<'CODE', <<'OUTPUT', "callmethod 1" );
  66 .sub main :main
  67     $P2 = newclass "Foo"
  68     $P3 = new $P2
  69     set $S0, "meth"
  70
  71     print "main\n"
  72     $P3.'meth'()
  73     print "back\n"
  74     end
  75 .end
  76
  77 .namespace ["Foo"]
  78 .sub meth :method
  79     print "in meth\n"
  80     .return ()
  81 .end
  82 CODE
  83 main
  84 in meth
  85 back
  86 OUTPUT
  87
  88 pir_output_is( <<'CODE', <<'OUTPUT', "can class" );
  89 .sub main :main
  90     $P2 = newclass "Foo"
  91
  92     $P3 = new ['Sub']
  93     # Add a method to the class manually
  94     $P2.'add_method'("meth", $P3)
  95
  96     # Classes only report 'can' for class methods, not instance methods
  97     can $I0, $P2, "meth"
  98     print $I0
  99     print "\n"
 100     end
 101 .end
 102 CODE
 103 0
 104 OUTPUT
 105
 106 pir_output_is( <<'CODE', <<'OUTPUT', "can object" );
 107 .sub main :main
 108     $P2 = newclass "Foo"
 109     $P4 = new ['Foo']
 110
 111     $P3 = new ['Sub']
 112     # Add a method to the class manually
 113     $P2.'add_method'("meth", $P3)
 114
 115     can $I0, $P4, "meth"
 116     print $I0
 117     print "\n"
 118     can $I0, $P4, "no_such_meth"
 119     print $I0
 120     print "\n"
 121     end
 122 .end
 123 CODE
 124 1
 125 0
 126 OUTPUT
 127
 128 pir_output_is( <<'CODE', <<'OUTPUT', "constructor" );
 129 .sub main :main
 130     $P1 = newclass "Foo"
 131     new $P3, ['Foo']
 132     print "ok 2\n"
 133     end
 134 .end
 135
 136 .namespace ["Foo"]
 137 .sub init :method :vtable
 138     print "ok 1\n"
 139 .end
 140 CODE
 141 ok 1
 142 ok 2
 143 OUTPUT
 144
 145 pir_output_is( <<'CODE', <<'OUTPUT', "constructor - init attr" );
 146 .sub 'main' :main
 147     newclass $P1, "Foo"
 148     addattribute $P1, ".i"
 149     new $P3, ['Foo']
 150     say "ok 2"
 151     say $P3
 152     end
 153 .end
 154
 155 .namespace ["Foo"]
 156
 157 .sub 'init' :vtable :method
 158     say "ok 1"
 159     new $P10, ['Integer']
 160     set $P10, 42
 161     setattribute self, ".i", $P10
 162     .return()
 163 .end
 164
 165 .sub 'get_string' :vtable :method
 166     getattribute $P10, self, ".i"
 167     .return( $P10 )
 168 .end
 169 CODE
 170 ok 1
 171 ok 2
 172 42
 173 OUTPUT
 174
 175 pir_output_is( <<'CODE', <<'OUTPUT', "constructor - parents" );
 176 .sub 'main' :main
 177     newclass $P1, "Foo"
 178     subclass $P2, $P1, "Bar"
 179     subclass $P3, $P2, "Baz"
 180     new $P3, ['Baz']
 181     new $P3, ['Bar']
 182     _sub()
 183     say "done"
 184     end
 185 .end
 186
 187 .namespace ["Foo"]
 188
 189 .sub 'init' :vtable :method
 190     say "foo_init"
 191     typeof $S0, self
 192     say $S0
 193 .end
 194
 195 .namespace ["Bar"]
 196
 197 .sub 'init' :vtable :method
 198     say "bar_init"
 199 .end
 200
 201 .namespace ["Baz"]
 202
 203 .sub 'init' :vtable :method
 204     say "baz_init"
 205 .end
 206
 207 .namespace [] # main again
 208
 209 .sub '_sub'
 210     say "in sub"
 211 .end
 212 CODE
 213 foo_init
 214 Baz
 215 bar_init
 216 baz_init
 217 foo_init
 218 Bar
 219 bar_init
 220 in sub
 221 done
 222 OUTPUT
 223
 224 pir_output_is( <<'CODE', <<'OUTPUT', "methods: self" );
 225
 226 .sub _main
 227     .local pmc A
 228     .local pmc B
 229
 230     newclass A, "A"
 231     newclass B, "B"
 232
 233     new A, ['A']
 234     new B, ['B']
 235
 236     setprop A, "B", B
 237
 238     A."foo"()
 239     B."foo"()
 240
 241     end
 242 .end
 243
 244 .namespace ["A"]
 245
 246 .sub foo :method
 247     .local pmc B
 248
 249     print "A::foo\n"
 250     getprop B, "B", self
 251
 252     self."blah"()
 253     B."blah"()
 254     self."blah"()
 255
 256 .end
 257
 258 .sub blah :method
 259     print "A::blah\n"
 260 .end
 261
 262 .namespace ["B"]
 263
 264 .sub foo :method
 265     print "B::foo\n"
 266 .end
 267
 268 .sub blah :method
 269     print "B::blah\n"
 270 .end
 271 CODE
 272 A::foo
 273 A::blah
 274 B::blah
 275 A::blah
 276 B::foo
 277 OUTPUT
 278
 279 pir_output_is( <<'CODE', <<'OUTPUT', "methods: self w arg" );
 280
 281 .sub _main
 282     .local pmc A
 283     .local pmc B
 284
 285     newclass A, "A"
 286     newclass B, "B"
 287
 288     new A, ['A']
 289     new B, ['B']
 290
 291     A."foo"(B)
 292     B."foo"()
 293
 294     end
 295 .end
 296
 297 .namespace ["A"]
 298
 299 .sub foo :method
 300     .param pmc B
 301
 302     print "A::foo\n"
 303
 304     self."blah"()
 305     B."blah"()
 306     self."blah"()
 307
 308 .end
 309
 310 .sub blah :method
 311     print "A::blah\n"
 312 .end
 313
 314 .namespace ["B"]
 315
 316 .sub foo :method
 317     print "B::foo\n"
 318 .end
 319
 320 .sub blah :method
 321     print "B::blah\n"
 322 .end
 323 CODE
 324 A::foo
 325 A::blah
 326 B::blah
 327 A::blah
 328 B::foo
 329 OUTPUT
 330
 331 pir_output_is( <<'CODE', <<'OUTPUT', "methods: self w arg and ret" );
 332
 333 .sub _main
 334     .local pmc A
 335     .local pmc B
 336
 337     newclass A, "A"
 338     newclass B, "B"
 339
 340     new A, ['A']
 341     new B, ['B']
 342
 343     .local pmc r
 344     r = A."foo"(B)
 345     r."foo"()
 346
 347     end
 348 .end
 349
 350 .namespace ["A"]
 351
 352 .sub foo :method
 353     .param pmc B
 354
 355     print "A::foo\n"
 356
 357     self."blah"()
 358     B."blah"()
 359     self."blah"()
 360     .begin_return
 361     .set_return B
 362     .end_return
 363
 364 .end
 365
 366 .sub blah :method
 367     print "A::blah\n"
 368 .end
 369
 370 .namespace ["B"]
 371
 372 .sub foo :method
 373     print "B::foo\n"
 374 .end
 375
 376 .sub blah :method
 377     print "B::blah\n"
 378 .end
 379 CODE
 380 A::foo
 381 A::blah
 382 B::blah
 383 A::blah
 384 B::foo
 385 OUTPUT
 386
 387 SKIP: {
 388     skip( "currently broken", 1 );
 389     pasm_output_is( <<'CODE', <<'OUTPUT', "exceptions and different runloops" );
 390 _main:
 391     push_eh eh
 392
 393     newclass P0, "Foo"
 394
 395     print "new\n"
 396     new P2, ['Foo']
 397 eh:
 398     print "back in main\n"
 399     end
 400
 401 .namespace ["Foo"]
 402 .pcc_sub __init:
 403     print "in __init\n"
 404
 405     # raise an exception
 406     callmethodcc self, "qux"
 407
 408     print "never\n"
 409     returncc
 410 CODE
 411 new
 412 in __init
 413 back in main
 414 OUTPUT
 415 }
 416
 417 pasm_output_is( <<'CODE', <<'OUTPUT', "find_method" );
 418     newclass P3, "Foo"
 419     new P2, ['Foo']
 420
 421     set S0, "meth"
 422     find_method P0, P2, S0
 423     print "main\n"
 424     callmethodcc P2, P0
 425     print "back\n"
 426     end
 427
 428 .namespace ["Foo"]
 429 .pcc_sub :method meth:
 430     print "in meth\n"
 431     returncc
 432 CODE
 433 main
 434 in meth
 435 back
 436 OUTPUT
 437
 438 pasm_error_output_like( <<'CODE', <<'OUTPUT', "find_method - unknown method" );
 439     newclass P2, "Foo"
 440     set S0, "nada"
 441     find_method P0, P2, S0
 442     print "nope\n"
 443     end
 444 CODE
 445 /Method 'nada' not found for invocant of class 'Foo'/
 446 OUTPUT
 447
 448 pir_output_is( <<'CODE', <<'OUTPUT', "constructor - diamond parents" );
 449 #
 450 # A   B A   E
 451 #  \ /   \ /
 452 #   C     D
 453 #    \   /
 454 #     \ /
 455 #      F
 456 .sub 'main' :main
 457     newclass $P1, "A"
 458     newclass $P2, "B"
 459     subclass $P3, $P1, "C"
 460     addparent $P3, $P2
 461
 462     subclass $P4, $P1, "D"
 463     newclass $P5, "E"
 464     addparent $P4, $P5
 465
 466     subclass $P6, $P3, "F"
 467     addparent $P6, $P4
 468
 469     print "F isa D "
 470     isa $I0, $P6, "D"
 471     say $I0
 472     print "D isa F "
 473     isa $I0, $P4, "F"
 474     say $I0
 475     print "F isa C "
 476     isa $I0, $P6, "C"
 477     say $I0
 478     print "C isa F "
 479     isa $I0, $P3, "F"
 480     say $I0
 481     print "F isa E "
 482     isa $I0, $P6, "E"
 483     say $I0
 484     print "E isa F "
 485     isa $I0, $P5, "F"
 486     say $I0
 487     print "F isa A "
 488     isa $I0, $P6, "A"
 489     say $I0
 490     print "A isa F "
 491     isa $I0, $P1, "F"
 492     say $I0
 493     print "F isa B "
 494     isa $I0, $P6, "B"
 495     say $I0
 496     print "B isa F "
 497     isa $I0, $P2, "F"
 498     say $I0
 499
 500     print "C isa A "
 501     isa $I0, $P3, "A"
 502     say $I0
 503     print "A isa C "
 504     isa $I0, $P1, "C"
 505     say $I0
 506     print "D isa A "
 507     isa $I0, $P4, "A"
 508     say $I0
 509     print "A isa D "
 510     isa $I0, $P1, "D"
 511     say $I0
 512
 513     say "new F"
 514     new $P16, ['F']
 515     say "done"
 516 .end
 517
 518 .namespace ["A"]
 519
 520 .sub 'init' :vtable :method
 521     say "A init"
 522 .end
 523
 524 .namespace ["B"]
 525
 526 .sub 'init' :vtable :method
 527     say "B init"
 528 .end
 529
 530 .namespace ["C"]
 531
 532 .sub 'init' :vtable :method
 533     say "C init"
 534 .end
 535
 536 .namespace ["D"]
 537
 538 .sub 'init' :vtable :method
 539     say "D init"
 540 .end
 541
 542 .namespace ["E"]
 543
 544 .sub 'init' :vtable :method
 545     say "E init"
 546 .end
 547
 548 .namespace ["F"]
 549
 550 .sub 'init' :vtable :method
 551     say "F init"
 552 .end
 553 CODE
 554 F isa D 1
 555 D isa F 0
 556 F isa C 1
 557 C isa F 0
 558 F isa E 1
 559 E isa F 0
 560 F isa A 1
 561 A isa F 0
 562 F isa B 1
 563 B isa F 0
 564 C isa A 1
 565 A isa C 0
 566 D isa A 1
 567 A isa D 0
 568 new F
 569 E init
 570 B init
 571 A init
 572 D init
 573 C init
 574 F init
 575 done
 576 OUTPUT
 577
 578 pir_output_is( <<'CODE', <<'OUTPUT', "constructor - vtable override" );
 579 .sub main :main
 580   $P0 = newclass 'Foo'
 581   $P1 = subclass 'Foo', 'Bar'
 582   $P2 = new ['Bar']
 583 .end
 584
 585 .namespace ['Foo']
 586 .sub init :vtable :method
 587   print "foo init\n"
 588 .end
 589
 590 .namespace ['Bar']
 591 .sub init :vtable :method
 592   print "bar init\n"
 593 .end
 594
 595 CODE
 596 foo init
 597 bar init
 598 OUTPUT
 599
 600 pir_output_is( <<'CODE', <<'OUTPUT', "same method name in two namespaces" );
 601
 602 .namespace ["A"]
 603 .sub foo :method
 604     .param int i
 605
 606     .begin_return
 607     .end_return
 608 .end
 609
 610 .namespace ["B"]
 611 .sub foo :method
 612     .param int i
 613
 614     .begin_return
 615     .end_return
 616 .end
 617
 618 .namespace []
 619 .sub _main :main
 620     print "ok\n"
 621 .end
 622 CODE
 623 ok
 624 OUTPUT
 625
 626 pir_output_is( <<'CODE', <<'OUTPUT', "self - CURRENT_OBJECT" );
 627
 628 .sub _main
 629     .local pmc A
 630
 631     newclass A, "A"
 632     new A, ['A']
 633     A."foo"()
 634     end
 635 .end
 636
 637 .namespace ["A"]
 638
 639 .sub foo :method
 640     .include "interpinfo.pasm"
 641     $P0 = interpinfo .INTERPINFO_CURRENT_OBJECT
 642     eq_addr self, $P0, ok
 643     print "not "
 644 ok: print "ok\n"
 645 .end
 646 CODE
 647 ok
 648 OUTPUT
 649
 650 pir_output_is( <<'CODE', <<'OUTPUT', "Bug in method calling with nonconst keys" );
 651
 652 .sub _main
 653     newclass $P0, "Foo"
 654
 655     new $P1, ['Foo']
 656
 657     $I1 = $P1["foo"]
 658
 659     $S0 = "foo"
 660     $I1 = $P1[$S0]
 661
 662     end
 663 .end
 664
 665 .namespace ["Foo"]
 666
 667 .sub get_integer_keyed :vtable :method
 668     .param pmc key
 669     print "Key = "
 670     print key
 671     print "\n"
 672     .return(0)
 673 .end
 674 CODE
 675 Key = foo
 676 Key = foo
 677 OUTPUT
 678
 679 pir_output_is( <<'CODE', <<'OUTPUT', "Bug in method calling with nonconst keys - clobber" );
 680
 681 .sub _main
 682     newclass $P0, "Foo"
 683
 684     new $P1, ['Foo']
 685
 686     $I1 = $P1["foo"]
 687
 688     $S0 = "foo"
 689     $I1 = $P1[$S0]
 690
 691     end
 692 .end
 693
 694 .namespace ["Foo"]
 695
 696 .sub get_integer_keyed :vtable :method
 697     .param pmc key
 698     $S0 = "bar"
 699     print "Key = "
 700     print key
 701     print "\n"
 702     print $S0
 703     print "\n"
 704     .return(0)
 705 .end
 706 CODE
 707 Key = foo
 708 bar
 709 Key = foo
 710 bar
 711 OUTPUT
 712
 713 pir_output_is( <<'CODE', <<'OUTPUT', "method cache invalidation" );
 714 .sub main :main
 715     .local pmc o, cl
 716     newclass cl, "Foo"
 717     subclass cl, cl, "Bar"
 718     o = new ['Bar']
 719     print o
 720     $P0 = get_global "ok2"
 721     cl.'add_vtable_override'('get_string', $P0)
 722     print o
 723 .end
 724 .sub ok2
 725     .return("ok 2\n")
 726 .end
 727 .namespace [ "Foo" ]
 728 .sub get_string :vtable :method
 729     .return("ok 1\n")
 730 .end
 731 CODE
 732 ok 1
 733 ok 2
 734 OUTPUT
 735
 736 pir_output_is( <<'CODE', <<'OUTPUT', "callmethod - method name" );
 737 .sub main :main
 738     $P2 = newclass "Foo"
 739     $S0 = "meth"
 740     print "main\n"
 741     $P3 = new $P2
 742     $P3.$S0()
 743     print "back\n"
 744     end
 745 .end
 746
 747 .namespace ["Foo"]
 748 .sub meth :method
 749     print "in meth\n"
 750     getinterp $P0
 751     $P1 = $P0["sub"]
 752     print $P1
 753     print "\n"
 754     .return ()
 755 .end
 756 CODE
 757 main
 758 in meth
 759 meth
 760 back
 761 OUTPUT
 762
 763 SKIP: {
 764     skip( "no bound NCI method", 1 );
 765     pir_output_is( <<'CODE', <<'OUTPUT', "bound NCI method" );
 766 .sub main :main
 767     .local pmc s, l, f
 768     s = new ['String']
 769     s = "ABC\n"
 770     f = getattribute s, "lower"
 771     typeof $S0, f
 772     print $S0
 773     print "\n"
 774     l = f()
 775     print l
 776 .end
 777 CODE
 778 Bound_NCI
 779 abc
 780 OUTPUT
 781 }
 782
 783 pir_output_is( <<'CODE', <<'OUTPUT', "tailcallmeth" );
 784 .sub main :main
 785     .local pmc cl, o, n
 786     cl = newclass "Foo"
 787     addattribute cl, "n"
 788     o = new ['Foo']
 789     n = new ['Integer']
 790     n = 2000
 791     setattribute o, [ "Foo" ], "n", n
 792     o.'go'()
 793     n = getattribute o, [ "Foo" ], "n"
 794     print n
 795     print "\n"
 796 .end
 797
 798 .namespace ["Foo"]
 799 .sub go :method
 800     .local pmc n
 801     n = getattribute self, [ "Foo" ], "n"
 802     dec n
 803     unless n goto done
 804     .tailcall self."go"()
 805 done:
 806 .end
 807 CODE
 808 0
 809 OUTPUT
 810
 811 pir_output_is( <<'CODE', <<'OUTPUT', "kind of a super" );
 812 .sub main :main
 813     .local pmc cl, o
 814     cl = subclass "String", "MyString"
 815     o = new ['MyString']
 816     o = "foo"
 817     print o
 818     print "\n"
 819 .end
 820
 821 .namespace ["MyString"]
 822 .sub set_string_native :vtable :method
 823     .param string s
 824     $P0 = getattribute self, ["String"], 'proxy'
 825     s .= s
 826     $P0 = s
 827 .end
 828 CODE
 829 foofoo
 830 OUTPUT
 831
 832 pir_output_is( <<'CODE', <<'OUTPUT', "delegate keyed_int" );
 833 .sub main :main
 834     .local pmc cl, o
 835     cl = newclass "MyClass"
 836     o = new ['MyClass']
 837     $I0 = 5
 838     $S0 = "foo"
 839     o[$I0] = 42
 840     o[$S0] = 42
 841     delete o[$I0]
 842     delete o[$S0]
 843     $I1 = defined o[$I0]
 844     $I1 = defined o[$S0]
 845     $I1 = exists o[$I0]
 846     $I1 = exists o[$S0]
 847 .end
 848
 849 .namespace ["MyClass"]
 850
 851 .sub set_integer_keyed_int :vtable :method
 852     .param int key
 853     .param int val
 854     print "ikey\n"
 855 .end
 856
 857 .sub set_integer_keyed :vtable :method
 858     .param string key
 859     .param int val
 860     print "skey\n"
 861 .end
 862
 863 .sub delete_keyed_int :vtable :method
 864     .param int key
 865     print "del_ikey\n"
 866 .end
 867
 868 .sub delete_keyed :vtable :method
 869     .param string key
 870     print "del_skey\n"
 871 .end
 872
 873 .sub defined_keyed_int :vtable :method
 874     .param int key
 875     print "def_ikey\n"
 876     .return (0)
 877 .end
 878
 879 .sub defined_keyed :vtable :method
 880     .param string key
 881     print "def_skey\n"
 882     .return (0)
 883 .end
 884
 885 .sub exists_keyed_int :vtable :method
 886     .param int key
 887     print "exists_ikey\n"
 888     .return (0)
 889 .end
 890
 891 .sub exists_keyed :vtable :method
 892     .param string key
 893     print "exists_skey\n"
 894     .return (0)
 895 .end
 896
 897 CODE
 898 ikey
 899 skey
 900 del_ikey
 901 del_skey
 902 def_ikey
 903 def_skey
 904 exists_ikey
 905 exists_skey
 906 OUTPUT
 907
 908 pir_output_is( <<'CODE', <<'OUTPUT', "delegate keyed_int PMC derived" );
 909 .sub main :main
 910     .local pmc cl, o
 911     cl = subclass "ResizablePMCArray", "MyClass"
 912     o = new ['MyClass']
 913     $I0 = 5
 914     o[$I0] = 42
 915     $I1 = o[$I0]
 916     print $I1
 917     print "\n"
 918 .end
 919
 920 .namespace ["MyClass"]
 921
 922 .sub get_integer_keyed_int :vtable :method
 923     .param int key
 924     print "ikey\n"
 925     .local pmc ar
 926     ar = getattribute self, ["ResizablePMCArray"], "proxy"
 927     $I0 = ar[key]
 928     .return ($I0)
 929 .end
 930
 931 .sub set_integer_keyed_int :vtable :method
 932     .param int key
 933     .param int val
 934     print "pkey\n"
 935     .local pmc ar
 936     ar = getattribute self, ["ResizablePMCArray"], "proxy"
 937     ar[key] = val
 938 .end
 939
 940 CODE
 941 pkey
 942 ikey
 943 42
 944 OUTPUT
 945
 946 pir_output_is( <<'CODE', <<'OUTPUT', "delegate keyed_int PMC derived - inherit" );
 947 .sub main :main
 948     .local pmc cl, o
 949     cl = subclass "ResizablePMCArray", "MyClass"
 950     o = new ['MyClass']
 951     $I0 = 5
 952     o[$I0] = 42
 953     $I1 = o[$I0]
 954     print $I1
 955     print "\n"
 956 .end
 957
 958 .namespace ["MyClass"]
 959
 960 .sub get_integer_keyed_int :vtable :method
 961     .param int key
 962     print "ikey\n"
 963     .local pmc ar
 964     ar = getattribute self, ["ResizablePMCArray"], "proxy"
 965     $I0 = ar[key]
 966     .return ($I0)
 967 .end
 968
 969 CODE
 970 ikey
 971 42
 972 OUTPUT
 973
 974 pir_output_is( <<'CODE', <<'OUTPUT', "addmethod op" );
 975 .sub main :main
 976     .local pmc c
 977     c = newclass ['whatever']
 978     .const 'Sub' foo = "whatever_foo"
 979     addmethod c, "foo", foo
 980     $P0 = new ['whatever']
 981     $P0.'foo'()
 982 .end
 983
 984 .sub whatever_foo :anon :method
 985     print "Foo!\n"
 986 .end
 987 CODE
 988 Foo!
 989 OUTPUT
 990
 991 pir_output_is( <<'CODE', <<'OUTPUT', "inherit a PMC METHOD" );
 992 .sub main :main
 993     .local pmc cl, o
 994     cl = subclass 'Integer', 'MyInt'
 995     o = new ['MyInt']
 996     o = 10
 997     $S0 = o.'get_as_base'(16)
 998     print $S0
 999     print "\n"
1000 .end
1001 CODE
1002 a
1003 OUTPUT
1004
1005 pir_output_is( <<'CODE', <<'OUTPUT', "init calls" );
1006 .sub main :main
1007     .local pmc cl, o
1008     cl = newclass 'MyClass'
1009     o = new ['MyClass']
1010     $P0 = new ['String']
1011     o = new ['MyClass'], $P0
1012 .end
1013
1014 .namespace ['MyClass']
1015
1016 .sub init :method :vtable
1017     .param pmc initializer :optional
1018     print "init was called\n"
1019 .end
1020
1021 .sub init_pmc :method :vtable
1022     .param pmc initializer
1023     print "init_pmc was called\n"
1024 .end
1025 CODE
1026 init was called
1027 init_pmc was called
1028 OUTPUT
1029
1030 pir_output_is( <<'CODE', <<'OUTPUT', "overloading find_method vtable" );
1031 .sub main :main
1032     .local pmc cl, o
1033     cl = newclass 'MyClass'
1034     o = new ['MyClass']
1035     o.'foo'()
1036 .end
1037
1038 .namespace ['MyClass']
1039
1040 .sub find_method :method :vtable
1041     .param string methodname
1042     print "find_method was called\n"
1043     $P0 = get_hll_global ["MyClass"], methodname
1044     .return($P0)
1045 .end
1046
1047 .sub foo
1048   print "foo was called\n"
1049 .end
1050
1051 CODE
1052 find_method was called
1053 foo was called
1054 OUTPUT
1055
1056 pir_output_is( <<'CODE', <<'OUTPUT', "overloading attribute accessor vtable" );
1057 .sub main :main
1058     .local pmc cl, o
1059     cl = newclass 'MyClass'
1060     o = new ['MyClass']
1061     $P2 = new ['String']
1062     $P2 = "blue"
1063     setattribute o, "blue", $P2
1064     $P1 = getattribute o, "blue"
1065 .end
1066
1067 .namespace ['MyClass']
1068
1069 .sub get_attr_str :method :vtable
1070     .param string attrname
1071     print "get_attr_str was called\n"
1072 .end
1073 .sub set_attr_str :method :vtable
1074     .param string attrname
1075     .param pmc val
1076     print "set_attr_str was called\n"
1077 .end
1078 CODE
1079 set_attr_str was called
1080 get_attr_str was called
1081 OUTPUT
1082
1083 pir_error_output_like( <<'CODE', <<'OUTPUT', "method called on non-object" );
1084 .namespace [ 'Foo' ]
1085
1086 .sub 'blah' :method
1087 .end
1088
1089 .namespace []
1090
1091 .sub main :main
1092     $P1 = get_hll_global 'Foo'
1093     $P0 = $P1.'new'()
1094 .end
1095 CODE
1096 /Method 'new' not found for non-object/
1097 OUTPUT
1098
1099 # Local Variables:
1100 #   mode: cperl
1101 #   cperl-indent-level: 4
1102 #   fill-column: 100
1103 # End:
1104 # vim: expandtab shiftwidth=4: