t/pmc/namespace.t

   1 #! perl
   2 # Copyright (C) 2001-2008, The Perl 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 => 65;
  10 use Parrot::Config;
  11
  12 =head1 NAME
  13
  14 t/pmc/namespace.t - test the NameSpace PMC as described in PDD21.
  15
  16 =head1 SYNOPSIS
  17
  18     % prove t/pmc/namespace.t
  19
  20 =head1 DESCRIPTION
  21
  22 Test the NameSpace PMC as described in PDD21.
  23
  24 =cut
  25
  26 # L<PDD21/Namespace PMC API/>
  27 pir_output_is( <<'CODE', <<'OUT', 'new' );
  28 .sub 'test' :main
  29     new $P0, 'NameSpace'
  30     say "ok 1 - $P0 = new 'NameSpace'"
  31 .end
  32 CODE
  33 ok 1 - $P0 = new 'NameSpace'
  34 OUT
  35
  36 # L<PDD21/Namespace PMC API/=head4 Untyped Interface>
  37 pir_output_is( <<'CODE', <<'OUT', 'NameSpace does "hash"' );
  38 .sub 'test' :main
  39     new $P0, 'NameSpace'
  40     $I0 = does $P0, 'hash'
  41     if $I0 goto ok_1
  42     print 'not '
  43   ok_1:
  44     say 'ok 1 - NameSpace does "hash"'
  45 .end
  46 CODE
  47 ok 1 - NameSpace does "hash"
  48 OUT
  49
  50 # L<PDD21//>
  51 pir_output_is( <<'CODE', <<'OUTPUT', "get_global bar" );
  52 .sub 'main' :main
  53     $P0 = get_global "bar"
  54     print "ok\n"
  55     $P0()
  56 .end
  57
  58 .sub 'bar'
  59     print "bar\n"
  60 .end
  61 CODE
  62 ok
  63 bar
  64 OUTPUT
  65
  66 pir_output_is( <<'CODE', <<'OUTPUT', "verify NameSpace type" );
  67 .sub 'main' :main
  68     $P0 = get_global "Foo"
  69     typeof $S0, $P0
  70     print $S0
  71     print "\n"
  72 .end
  73
  74 .namespace ["Foo"]
  75 .sub 'bar'
  76     noop
  77 .end
  78 CODE
  79 NameSpace
  80 OUTPUT
  81
  82 pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::bar" );
  83 .sub 'main' :main
  84     $P0 = get_global ["Foo"], "bar"
  85     print "ok\n"
  86     $P0()
  87 .end
  88
  89 .namespace ["Foo"]
  90 .sub 'bar'
  91     print "bar\n"
  92 .end
  93 CODE
  94 ok
  95 bar
  96 OUTPUT
  97
  98 pir_output_is( <<'CODE', <<'OUTPUT', "get_namespace Foo::bar" );
  99 .sub 'main' :main
 100     $P0 = get_global ["Foo"], "bar"
 101     print "ok\n"
 102     $P1 = $P0."get_namespace"()
 103     print $P1
 104     print "\n"
 105 .end
 106
 107 .namespace ["Foo"]
 108 .sub 'bar'
 109 .end
 110 CODE
 111 ok
 112 Foo
 113 OUTPUT
 114
 115 pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::bar ns" );
 116 .sub 'main' :main
 117     $P1 = get_global ["Foo"], "bar"
 118     print "ok\n"
 119     $P1()
 120 .end
 121
 122 .namespace ["Foo"]
 123 .sub 'bar'
 124     print "bar\n"
 125 .end
 126 CODE
 127 ok
 128 bar
 129 OUTPUT
 130
 131 pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::bar hash" );
 132 .sub 'main' :main
 133     $P0 = get_global "Foo"
 134     $P1 = $P0["bar"]
 135     print "ok\n"
 136     $P1()
 137 .end
 138
 139 .namespace ["Foo"]
 140 .sub 'bar'
 141     print "bar\n"
 142 .end
 143 CODE
 144 ok
 145 bar
 146 OUTPUT
 147
 148 pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::baz" );
 149 .sub 'main' :main
 150     $P2 = get_global ["Foo";"Bar"], "baz"
 151     print "ok\n"
 152     $P2()
 153 .end
 154
 155 .namespace ["Foo" ; "Bar"]
 156 .sub 'baz'
 157     print "baz\n"
 158 .end
 159 CODE
 160 ok
 161 baz
 162 OUTPUT
 163
 164 pir_error_output_like( <<'CODE', <<'OUTPUT', "get_global Foo::bazz not found" );
 165 .sub 'main' :main
 166     $P2 = get_global ["Foo"], "bazz"
 167     $P2()
 168     print "ok\n"
 169 .end
 170 CODE
 171 /Null PMC access in invoke\(\)/
 172 OUTPUT
 173
 174 # [this used to behave differently from the previous case.]
 175 pir_error_output_like( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::bazz not found" );
 176 .sub 'main' :main
 177     $P2 = get_global ["Foo";"Bar"], "bazz"
 178     $P2()
 179     print "ok\n"
 180 .end
 181 CODE
 182 /Null PMC access in invoke\(\)/
 183 OUTPUT
 184
 185 pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::baz hash" );
 186 .sub 'main' :main
 187     $P0 = get_global "Foo"
 188     $P1 = $P0["Bar"]
 189     $P2 = $P1["baz"]
 190     print "ok\n"
 191     $P2()
 192 .end
 193
 194 .namespace ["Foo"; "Bar"]
 195 .sub 'baz'
 196     print "baz\n"
 197 .end
 198 CODE
 199 ok
 200 baz
 201 OUTPUT
 202
 203 pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::baz hash 2" );
 204 .sub 'main' :main
 205     $P0 = get_global "Foo"
 206     $P1 = $P0["Bar" ; "baz"]
 207     print "ok\n"
 208     $P1()
 209 .end
 210
 211 .namespace ["Foo"; "Bar"]
 212 .sub 'baz'
 213     print "baz\n"
 214 .end
 215 CODE
 216 ok
 217 baz
 218 OUTPUT
 219
 220 pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::baz alias" );
 221 .sub 'main' :main
 222     $P0 = get_global "Foo"
 223     $P1 = $P0["Bar"]
 224     set_global "TopBar", $P1
 225     $P2 = get_global ["TopBar"], "baz"
 226     print "ok\n"
 227     $P2()
 228 .end
 229
 230 .namespace ["Foo"; "Bar"]
 231 .sub 'baz'
 232     print "baz\n"
 233 .end
 234 CODE
 235 ok
 236 baz
 237 OUTPUT
 238
 239 pir_error_output_like( <<'CODE', <<'OUTPUT', "func() namespace resolution" );
 240 .sub 'main' :main
 241     print "calling foo\n"
 242     foo()
 243     print "calling Foo::foo\n"
 244     $P0 = get_global ["Foo"], "foo"
 245     $P0()
 246     print "calling baz\n"
 247     baz()
 248 .end
 249
 250 .sub 'foo'
 251     print "  foo\n"
 252     bar()
 253 .end
 254
 255 .sub 'bar'
 256     print "  bar\n"
 257 .end
 258
 259 .sub 'fie'
 260     print "  fie\n"
 261 .end
 262
 263 .namespace ["Foo"]
 264
 265 .sub 'foo'
 266     print "  Foo::foo\n"
 267     bar()
 268     fie()
 269 .end
 270
 271 .sub 'bar'
 272     print "  Foo::bar\n"
 273 .end
 274
 275 .sub 'baz'
 276     print "  Foo::baz\n"
 277 .end
 278 CODE
 279 /calling foo
 280   foo
 281   bar
 282 calling Foo::foo
 283   Foo::foo
 284   Foo::bar
 285   fie
 286 calling baz
 287 Could not find non-existent sub baz/
 288 OUTPUT
 289
 290 pir_output_is( <<'CODE', <<'OUTPUT', 'get namespace of :anon .sub' );
 291 .namespace ['lib']
 292 .sub main :main :anon
 293     $P0 = get_namespace
 294     $P0 = $P0.'get_name'()
 295     $S0 = join "::", $P0
 296     say $S0
 297     end
 298 .end
 299 CODE
 300 parrot::lib
 301 OUTPUT
 302
 303 pir_output_is( <<'CODE', <<'OUTPUT', "get namespace in Foo::bar" );
 304 .sub 'main' :main
 305     $P0 = get_global ["Foo"], "bar"
 306     print "ok\n"
 307     $P0()
 308 .end
 309
 310 .namespace ["Foo"]
 311 .sub 'bar'
 312     print "bar\n"
 313     .include "interpinfo.pasm"
 314     $P0 = interpinfo .INTERPINFO_CURRENT_SUB
 315     $P1 = $P0."get_namespace"()
 316     print $P1
 317     print "\n"
 318 .end
 319 CODE
 320 ok
 321 bar
 322 Foo
 323 OUTPUT
 324
 325 pir_output_is( <<'CODE', <<'OUTPUT', "get namespace in Foo::Bar::baz" );
 326 .sub 'main' :main
 327     $P0 = get_global "Foo"
 328     $P1 = $P0["Bar"]
 329     $P2 = $P1["baz"]
 330     print "ok\n"
 331     $P2()
 332 .end
 333
 334 .namespace ["Foo" ; "Bar"]
 335 .sub 'baz'
 336     print "baz\n"
 337     .include "interpinfo.pasm"
 338     .include "pmctypes.pasm"
 339     $P0 = interpinfo .INTERPINFO_CURRENT_SUB
 340     $P1 = $P0."get_namespace"()
 341     $P2 = $P1.'get_name'()
 342     $S0 = join '::', $P2
 343     print $S0
 344     print "\n"
 345 .end
 346 CODE
 347 ok
 348 baz
 349 parrot::Foo::Bar
 350 OUTPUT
 351
 352 pir_output_is( <<'CODE', <<'OUTPUT', "segv in get_name" );
 353 .namespace ['pugs';'main']
 354 .sub 'main' :main
 355     $P0 = find_name "&say"
 356     $P0()
 357 .end
 358 .sub "&say"
 359     say "ok"
 360 .end
 361 CODE
 362 ok
 363 OUTPUT
 364
 365 pir_output_is( <<'CODE', <<'OUT', "latin1 namespace, global" );
 366 .namespace [ iso-8859-1:"François" ]
 367
 368 .sub 'test'
 369     print "latin1 namespaces are fun\n"
 370 .end
 371
 372 .namespace []
 373
 374 .sub 'main' :main
 375     $P0 = get_global [iso-8859-1:"François"], 'test'
 376     $P0()
 377 .end
 378 CODE
 379 latin1 namespaces are fun
 380 OUT
 381
 382 pir_output_is( <<'CODE', <<'OUT', "unicode namespace, global" );
 383 .namespace [ unicode:"Fran\xe7ois" ]
 384
 385 .sub 'test'
 386     print "unicode namespaces are fun\n"
 387 .end
 388
 389 .namespace []
 390
 391 .sub 'main' :main
 392     $P0 = get_global [unicode:"Fran\xe7ois"], 'test'
 393     $P0()
 394 .end
 395 CODE
 396 unicode namespaces are fun
 397 OUT
 398
 399 pir_output_is( <<'CODE', <<'OUTPUT', "verify root and parrot namespaces" );
 400 # name may change though
 401 .sub main :main
 402     # root namespace
 403     $P0 = get_root_namespace
 404     typeof $S0, $P0
 405     print $S0
 406     print "\n"
 407     print $P0
 408     print "\n"
 409     # parrot namespace
 410     $P1 = $P0["parrot"]
 411     print $P1
 412     print "\n"
 413     typeof $S0, $P1
 414     print $S0
 415     print "\n"
 416 .end
 417 CODE
 418 NameSpace
 419
 420 parrot
 421 NameSpace
 422 OUTPUT
 423
 424 pir_output_is( <<'CODE', <<'OUTPUT', "ns.name()" );
 425 .sub main :main
 426     .include "interpinfo.pasm"
 427     $P0 = get_root_namespace
 428     $P1 = $P0["parrot"]
 429     $P3 = new 'NameSpace'
 430     $P1["Foo"] = $P3
 431     $P2 = $P3.'get_name'()
 432     $I2 = elements $P2
 433     print $I2
 434     print "\n"
 435     $S0 = join '::', $P2
 436     print $S0
 437     print "\n"
 438 .end
 439 CODE
 440 2
 441 parrot::Foo
 442 OUTPUT
 443
 444 pir_output_is( <<'CODE', <<'OUTPUT', "get_namespace_p_p, getnamespace_p_kc" );
 445 .sub main :main
 446     .include "interpinfo.pasm"
 447     $P3 = new 'NameSpace'
 448     set_hll_global "Foo", $P3
 449     # fetch w array
 450     $P4 = new 'FixedStringArray'
 451     $P4 = 1
 452     $P4[0] = 'Foo'
 453     $P0 = get_hll_namespace $P4
 454     $P2 = $P0.'get_name'()
 455     $I2 = elements $P2
 456     print $I2
 457     print "\n"
 458     $S0 = join '::', $P2
 459     print $S0
 460     print "\n"
 461     # fetch w key
 462     $P2 = get_hll_namespace ["Foo"]
 463     $P2 = $P2.'get_name'()
 464     $I2 = elements $P2
 465     print $I2
 466     print "\n"
 467     $S0 = join '::', $P2
 468     print $S0
 469     print "\n"
 470 .end
 471 CODE
 472 2
 473 parrot::Foo
 474 2
 475 parrot::Foo
 476 OUTPUT
 477
 478 pir_output_is( <<'CODE', <<'OUTPUT', "Sub.get_namespace, get_namespace" );
 479 .sub 'main' :main
 480     $P0 = get_global ["Foo"], "bar"
 481     print "ok\n"
 482     $P1 = $P0."get_namespace"()
 483     $P2 = $P1.'get_name'()
 484     $S0 = join '::', $P2
 485     print $S0
 486     print "\n"
 487     $P0()
 488 .end
 489
 490 .namespace ["Foo"]
 491 .sub 'bar'
 492     $P1 = get_namespace
 493     print $P1
 494     print "\n"
 495 .end
 496 CODE
 497 ok
 498 parrot::Foo
 499 Foo
 500 OUTPUT
 501
 502 pir_output_is( <<'CODE', <<'OUTPUT', "check parrot ns" );
 503 .sub 'main' :main
 504     $P0 = get_global ["String"], "lower"
 505     $S0 = $P0("OK\n")
 506     print $S0
 507 .end
 508 CODE
 509 ok
 510 OUTPUT
 511
 512 my $temp_a = "temp_a";
 513 my $temp_b = "temp_b";
 514
 515 END {
 516     unlink( "$temp_a.pir", "$temp_a.pbc", "$temp_b.pir", "$temp_b.pbc" );
 517 }
 518
 519 open my $S, '>', "$temp_a.pir" or die "Can't write $temp_a.pir";
 520 print $S <<'EOF';
 521 .HLL "Foo", ""
 522 .namespace ["Foo_A"]
 523 .sub loada :load
 524     $P0 = get_global ["Foo_A"], "A"
 525     print "ok 1\n"
 526     load_bytecode "temp_b.pbc"
 527 .end
 528
 529 .sub A
 530 .end
 531 EOF
 532 close $S;
 533
 534 open $S, '>', "$temp_b.pir" or die "Can't write $temp_b.pir";
 535 print $S <<'EOF';
 536 .namespace ["Foo_B"]
 537 .sub loadb :load
 538     $P0 = get_global ["Foo_B"], "B"
 539     print "ok 2\n"
 540 .end
 541
 542 .sub B
 543 .end
 544 EOF
 545
 546 close $S;
 547
 548 system(".$PConfig{slash}parrot$PConfig{exe} -o $temp_a.pbc $temp_a.pir");
 549 system(".$PConfig{slash}parrot$PConfig{exe} -o $temp_b.pbc $temp_b.pir");
 550
 551 pir_output_is( <<'CODE', <<'OUTPUT', "HLL and load_bytecode - #38888" );
 552 .sub main :main
 553     load_bytecode "temp_a.pbc"
 554     print "ok 3\n"
 555 .end
 556 CODE
 557 ok 1
 558 ok 2
 559 ok 3
 560 OUTPUT
 561
 562 pir_output_is( <<'CODE', <<'OUTPUT', "HLL and vars" );
 563 # initial storage of _tcl global variable...
 564
 565 .HLL '_Tcl', ''
 566
 567 .sub huh
 568   $P0 = new 'Integer'
 569   $P0 = 3.14
 570   set_global '$variable', $P0
 571 .end
 572
 573 # start running HLL language
 574 .HLL 'Tcl', ''
 575
 576 .sub foo :main
 577   huh()
 578   $P1 = get_root_namespace ['_tcl']
 579   $P2 = $P1['$variable']
 580   print $P2
 581   print "\n"
 582 .end
 583 CODE
 584 3.14
 585 OUTPUT
 586
 587 pir_output_is( <<'CODE', <<'OUTPUT', "HLL and namespace directives" );
 588 .HLL '_Tcl', ''
 589 .namespace ['Foo'; 'Bar']
 590
 591 .HLL 'Tcl', ''
 592
 593 .sub main :main
 594   $P0 = get_namespace
 595   $P1 = $P0.'get_name'()
 596   $S0 = join "::", $P1
 597   print $S0
 598   print "\n"
 599   end
 600 .end
 601 CODE
 602 tcl
 603 OUTPUT
 604
 605 {
 606     my $temp_a = "temp_a.pir";
 607
 608     END {
 609         unlink($temp_a);
 610     }
 611
 612     open $S, '>', $temp_a or die "Can't write $temp_a";
 613     print $S <<'EOF';
 614 .HLL 'eek', ''
 615
 616 .sub foo :load :anon
 617   $P1 = new 'String'
 618   $P1 = "3.14\n"
 619   set_global '$whee', $P1
 620 .end
 621
 622 .sub bark
 623   $P0 = get_global '$whee'
 624   print $P0
 625 .end
 626 EOF
 627     close $S;
 628
 629     pir_output_is( <<'CODE', <<'OUTPUT', ":anon subs still get default namespace" );
 630 .HLL 'cromulent', ''
 631
 632 .sub what
 633    load_bytecode 'temp_a.pir'
 634   .local pmc var
 635    var = get_root_namespace
 636    var = var['eek']
 637    var = var['bark']
 638
 639     var()
 640 .end
 641 CODE
 642 3.14
 643 OUTPUT
 644 }
 645
 646 SKIP:
 647 {
 648     skip( "immediate test, doesn't with -r (from .pbc)", 1 )
 649         if ( exists $ENV{TEST_PROG_ARGS} and $ENV{TEST_PROG_ARGS} =~ m/-r/ );
 650
 651     pir_output_is( <<'CODE', <<'OUTPUT', "get_global in current" );
 652 .HLL 'bork', ''
 653 .namespace []
 654
 655 .sub a :immediate
 656   $P1 = new 'String'
 657   $P1 = "ok\n"
 658   set_global ['sub_namespace'], "eek", $P1
 659 .end
 660
 661 .namespace [ 'sub_namespace' ]
 662
 663 .sub whee :main
 664  $P1 = get_global 'eek'
 665  print $P1
 666 .end
 667 CODE
 668 ok
 669 OUTPUT
 670 }
 671
 672 open $S, '>', "$temp_b.pir" or die "Can't write $temp_b.pir";
 673 print $S <<'EOF';
 674 .HLL 'B', ''
 675 .sub b_foo
 676     print "b_foo\n"
 677 .end
 678 EOF
 679 close $S;
 680
 681 pir_error_output_like( <<'CODE', <<'OUTPUT', 'export_to() with null destination throws exception' );
 682 .sub 'test' :main
 683     .local pmc nsa, nsb, ar
 684
 685     ar = new 'ResizableStringArray'
 686     push ar, 'foo'
 687     nsa = new 'Null'
 688     nsb = get_namespace ['B']
 689     nsb.'export_to'(nsa, ar)
 690 .end
 691
 692 .namespace ['B']
 693 .sub 'foo' :anon
 694 .end
 695 CODE
 696 /^destination namespace not specified\n/
 697 OUTPUT
 698
 699 pir_error_output_like(
 700     <<'CODE', <<'OUTPUT', 'export_to() with null exports default object set !!!UNSPECIFIED!!!' );
 701 .sub 'test' :main
 702     .local pmc nsa, nsb, ar
 703
 704     ar = new 'Null'
 705     nsa = get_namespace
 706     nsb = get_namespace ['B']
 707     nsb.'export_to'(nsa, ar)
 708 .end
 709
 710 .namespace ['B']
 711 .sub 'foo'
 712 .end
 713 CODE
 714 /^exporting default object set not yet implemented\n/
 715 OUTPUT
 716
 717 pir_error_output_like(
 718     <<'CODE', <<'OUTPUT', 'export_to() with empty array exports default object set !!!UNSPECIFIED!!!' );
 719 .sub 'test' :main
 720     .local pmc nsa, nsb, ar
 721
 722     ar = new 'ResizableStringArray'
 723     nsa = get_namespace
 724     nsb = get_namespace ['B']
 725     nsb.'export_to'(nsa, ar)
 726 .end
 727
 728 .namespace ['B']
 729 .sub 'foo'
 730 .end
 731 CODE
 732 /^exporting default object set not yet implemented\n/
 733 OUTPUT
 734
 735 pir_error_output_like(
 736     <<'CODE', <<'OUTPUT', 'export_to() with empty hash exports default object set !!!UNSPECIFIED!!!' );
 737 .sub 'test' :main
 738     .local pmc nsa, nsb, ar
 739
 740     ar = new 'Hash'
 741     nsa = get_namespace
 742     nsb = get_namespace ['B']
 743     nsb.'export_to'(nsa, ar)
 744 .end
 745
 746 .namespace ['B']
 747 .sub 'foo'
 748 .end
 749 CODE
 750 /^exporting default object set not yet implemented\n/
 751 OUTPUT
 752
 753 pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with array" );
 754 .HLL 'A', ''
 755 .sub main :main
 756     a_foo()
 757     load_bytecode "$temp_b.pir"
 758     .local pmc nsr, nsa, nsb, ar
 759     ar = new 'ResizableStringArray'
 760     push ar, "b_foo"
 761     nsr = get_root_namespace
 762     nsa = nsr['a']
 763     nsb = nsr['b']
 764     nsb."export_to"(nsa, ar)
 765     b_foo()
 766 .end
 767
 768 .sub a_foo
 769     print "a_foo\\n"
 770 .end
 771 CODE
 772 a_foo
 773 b_foo
 774 OUTPUT
 775
 776 pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with hash (empty value)" );
 777 .HLL 'A', ''
 778 .sub main :main
 779     a_foo()
 780     load_bytecode "$temp_b.pir"
 781     .local pmc nsr, nsa, nsb, ar
 782     ar = new 'Hash'
 783     ar["b_foo"] = ""
 784     nsr = get_root_namespace
 785     nsa = nsr['a']
 786     nsb = nsr['b']
 787     nsb."export_to"(nsa, ar)
 788     b_foo()
 789 .end
 790
 791 .sub a_foo
 792     print "a_foo\\n"
 793 .end
 794 CODE
 795 a_foo
 796 b_foo
 797 OUTPUT
 798
 799 pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with hash (null value)" );
 800 .HLL 'A', ''
 801 .sub main :main
 802     a_foo()
 803     load_bytecode "$temp_b.pir"
 804     .local pmc nsr, nsa, nsb, ar, nul
 805     nul = new 'Null'
 806     ar  = new 'Hash'
 807     ar["b_foo"] = nul
 808     nsr = get_root_namespace
 809     nsa = nsr['a']
 810     nsb = nsr['b']
 811     nsb."export_to"(nsa, ar)
 812     b_foo()
 813 .end
 814
 815 .sub a_foo
 816     print "a_foo\\n"
 817 .end
 818 CODE
 819 a_foo
 820 b_foo
 821 OUTPUT
 822
 823 pir_error_output_like( <<"CODE", <<'OUTPUT', "export_to -- success with hash (and value)" );
 824 .HLL 'A', ''
 825 .sub main :main
 826     a_foo()
 827     load_bytecode "$temp_b.pir"
 828     .local pmc nsr, nsa, nsb, ar
 829     ar = new 'Hash'
 830     ar["b_foo"] = "c_foo"
 831     nsr = get_root_namespace
 832     nsa = nsr['a']
 833     nsb = nsr['b']
 834     nsb."export_to"(nsa, ar)
 835     c_foo()
 836     b_foo()
 837 .end
 838
 839 .sub a_foo
 840     print "a_foo\\n"
 841 .end
 842 CODE
 843 /^a_foo
 844 b_foo
 845 Could not find non-existent sub b_foo/
 846 OUTPUT
 847
 848 pir_output_is( <<'CODE', <<'OUTPUT', "get_parent" );
 849 .sub main :main
 850     .local pmc ns
 851     ns = get_hll_namespace ['Foo']
 852     ns = ns.'get_parent'()
 853     print ns
 854     print "\n"
 855 .end
 856 .namespace ['Foo']
 857 .sub dummy
 858 .end
 859 CODE
 860 parrot
 861 OUTPUT
 862
 863 pir_output_is( <<'CODE', <<'OUTPUT', "get_global [''], \"print_ok\"" );
 864 .namespace ['']
 865
 866 .sub print_ok
 867   print "ok\n"
 868   .return()
 869 .end
 870
 871 .namespace ['foo']
 872
 873 .sub main :main
 874   $P0 = get_hll_global [''], 'print_ok'
 875   $P0()
 876   end
 877 .end
 878 CODE
 879 ok
 880 OUTPUT
 881
 882 pir_output_is( <<'CODE', <<'OUTPUT', "get_global with array ('')" );
 883 .namespace ['']
 884
 885 .sub print_ok
 886   print "ok\n"
 887   .return()
 888 .end
 889
 890 .namespace ['foo']
 891
 892 .sub main :main
 893   $P0 = new 'ResizableStringArray'
 894   $P0[0] = ''
 895   $P0 = get_hll_global $P0, 'print_ok'
 896   $P0()
 897   end
 898 .end
 899 CODE
 900 ok
 901 OUTPUT
 902
 903 pir_output_is( <<'CODE', <<'OUTPUT', "get_global with empty array" );
 904 .namespace []
 905
 906 .sub print_ok
 907   print "ok\n"
 908   .return()
 909 .end
 910
 911 .namespace ['foo']
 912
 913 .sub main :main
 914   $P0 = new 'ResizablePMCArray'
 915   $P0 = 0
 916   $P0 = get_hll_global $P0, 'print_ok'
 917   $P0()
 918   end
 919 .end
 920 CODE
 921 ok
 922 OUTPUT
 923
 924 pir_output_is( <<'CODE', <<'OUTPUT', "Namespace.get_global() with array ('')" );
 925 .namespace ['']
 926
 927 .sub print_ok
 928   print "ok\n"
 929   .return()
 930 .end
 931
 932 .namespace ['foo']
 933
 934 .sub main :main
 935   $P1 = new 'ResizableStringArray'
 936   $P1[0] = ''
 937   $P1 = get_hll_global $P1, 'print_ok'
 938   $P1()
 939   end
 940 .end
 941 CODE
 942 ok
 943 OUTPUT
 944
 945 pir_output_is( <<'CODE', <<'OUTPUT', "Namespace introspection" );
 946 .sub main :main
 947     .local pmc f
 948     f = get_hll_global ['Foo'], 'dummy'
 949     f()
 950 .end
 951 .namespace ['Foo']
 952 .sub dummy
 953     .local pmc interp, ns_caller
 954     interp = getinterp
 955     ns_caller = interp['namespace'; 1]
 956     print ns_caller
 957     print "\n"
 958 .end
 959 CODE
 960 parrot
 961 OUTPUT
 962
 963 pir_output_is( <<'CODE', <<'OUTPUT', "Nested namespace introspection" );
 964 .sub main :main
 965     .local string no_symbol
 966
 967     .local pmc foo_ns
 968     foo_ns = get_hll_namespace [ 'Foo' ]
 969     $S0    = foo_ns
 970     print "Found namespace: "
 971     print $S0
 972     print "\n"
 973
 974     .local pmc bar_ns
 975     bar_ns = foo_ns.find_namespace( 'Bar' )
 976     $S0    = bar_ns
 977     print "Found nested namespace: "
 978     print $S0
 979     print "\n"
 980
 981     .local pmc baz_ns
 982     baz_ns    = bar_ns.find_namespace( 'Baz' )
 983     no_symbol = 'Baz'
 984
 985     .local int is_defined
 986     is_defined = defined baz_ns
 987     if is_defined goto oops
 988     goto find_symbols
 989
 990   oops:
 991     print "Found non-null '"
 992     print no_symbol
 993     print "'\n"
 994     .return()
 995
 996   find_symbols:
 997     .local pmc a_sub
 998     a_sub = bar_ns.find_sub( 'a_sub' )
 999     $S0   = a_sub
1000     a_sub()
1001     print "Found sub: "
1002     print $S0
1003     print "\n"
1004
1005     .local pmc some_sub
1006     some_sub  = bar_ns.find_sub( 'some_sub' )
1007     no_symbol = 'some_sub'
1008
1009     is_defined = defined some_sub
1010     if is_defined goto oops
1011
1012     .local pmc a_var
1013     a_var    = bar_ns.find_var( 'a_var' )
1014     print "Found var: "
1015     print a_var
1016     print "\n"
1017
1018     .local pmc some_var
1019     some_var    = bar_ns.find_var( 'some_var' )
1020     no_symbol = 'some_var'
1021
1022     is_defined = defined some_var
1023     if is_defined goto oops
1024
1025 .end
1026
1027 .namespace ['Foo']
1028
1029 .sub some_sub
1030 .end
1031
1032 .namespace [ 'Foo'; 'Bar' ]
1033
1034 .sub a_sub
1035     .local pmc some_var
1036     some_var = new 'String'
1037     some_var = 'a string PMC'
1038     set_hll_global [ 'Foo'; 'Bar' ], 'a_var', some_var
1039 .end
1040 CODE
1041 Found namespace: Foo
1042 Found nested namespace: Bar
1043 Found sub: a_sub
1044 Found var: a string PMC
1045 OUTPUT
1046
1047 pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace' );
1048 .sub main :main
1049     .local pmc root_ns
1050     root_ns = get_root_namespace
1051     .local int is_defined
1052     is_defined = defined root_ns
1053     unless is_defined goto NO_NAMESPACE_FOUND
1054         print "Found root namespace.\n"
1055     NO_NAMESPACE_FOUND:
1056 .end
1057 CODE
1058 Found root namespace.
1059 OUTPUT
1060
1061 pir_output_is( <<'CODE', <<'OUTPUT', 'root namespace is not a class' );
1062 .sub main :main
1063     .local pmc root_ns
1064     root_ns = get_root_namespace
1065     .local pmc root_class
1066     root_class = get_class root_ns
1067     .local int is_class
1068     is_class = defined root_class
1069     say is_class
1070 .end
1071 CODE
1072 0
1073 OUTPUT
1074
1075 pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace "Foo"' );
1076 .sub main :main
1077     .local pmc foo_ns
1078     foo_ns = get_root_namespace [ "foo" ]
1079     .local int is_defined
1080     is_defined = defined foo_ns
1081     unless is_defined goto NO_NAMESPACE_FOUND
1082         print "Found root namespace 'foo'.\n"
1083     NO_NAMESPACE_FOUND:
1084 .end
1085 .HLL 'Foo', ''
1086 .sub dummy
1087 .end
1088 CODE
1089 Found root namespace 'foo'.
1090 OUTPUT
1091
1092 pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace "Foo", not there' );
1093 .sub main :main
1094     .local pmc foo_ns
1095     foo_ns = get_root_namespace [ "Foo" ]
1096     .local int is_defined
1097     is_defined = defined foo_ns
1098     if is_defined goto NAMESPACE_FOUND
1099         print "Didn't find root namespace 'Foo'.\n"
1100     NAMESPACE_FOUND:
1101 .end
1102
1103 .namespace [ "NotFoo" ]
1104 CODE
1105 Didn't find root namespace 'Foo'.
1106 OUTPUT
1107
1108 my $create_nested_key = <<'CREATE_NESTED_KEY';
1109 .sub create_nested_key
1110     .param string name
1111     .param pmc other_names :slurpy
1112
1113     .local pmc key
1114     key = new 'Key'
1115     key = name
1116
1117     .local int elem
1118     elem = other_names
1119
1120     if elem goto nested
1121     .return( key )
1122
1123   nested:
1124     .local pmc tail
1125     tail = create_nested_key(other_names :flat)
1126     push key, tail
1127
1128     .return( key )
1129 .end
1130 CREATE_NESTED_KEY
1131
1132 pir_output_is( <<"CODE", <<'OUTPUT', 'get_name()' );
1133 $create_nested_key
1134
1135 .sub main :main
1136     .local pmc key
1137     key = create_nested_key( 'SingleName' )
1138     print_namespace( key )
1139
1140     key = create_nested_key( 'Nested', 'Name', 'Space' )
1141     print_namespace( key )
1142
1143     key = get_namespace
1144
1145     .local pmc ns
1146     ns = key.'get_name'()
1147
1148     .local string ns_name
1149     ns_name = join ';', ns
1150     print ns_name
1151     print "\\n"
1152 .end
1153
1154 .sub 'print_namespace'
1155     .param pmc key
1156
1157     .local pmc get_ns
1158     get_ns = get_global key, 'get_namespace'
1159
1160     .local pmc ns
1161     ns = get_ns()
1162
1163     .local pmc name_array
1164     name_array = ns.'get_name'()
1165
1166     .local string name
1167     name = join ';', name_array
1168
1169     print name
1170     print "\\n"
1171 .end
1172
1173 .sub get_namespace
1174     .local pmc ns
1175     ns = get_namespace
1176     .return( ns )
1177 .end
1178
1179 .namespace [ 'SingleName' ]
1180
1181 .sub get_namespace
1182     .local pmc ns
1183     ns = get_namespace
1184     .return( ns )
1185 .end
1186
1187 .namespace [ 'Nested'; 'Name'; 'Space' ]
1188
1189 .sub get_namespace
1190     .local pmc ns
1191     ns = get_namespace
1192     .return( ns )
1193 .end
1194
1195 CODE
1196 parrot;SingleName
1197 parrot;Nested;Name;Space
1198 parrot
1199 OUTPUT
1200
1201 pir_output_is( <<"CODE", <<'OUTPUT', 'add_namespace()' );
1202 $create_nested_key
1203
1204 .sub main :main
1205     .local pmc root_ns
1206     root_ns = get_namespace
1207
1208     .local pmc child_ns
1209     child_ns = new 'NameSpace'
1210     root_ns.'add_namespace'( 'Nested', child_ns )
1211
1212     .local pmc grandchild_ns
1213     grandchild_ns = new 'NameSpace'
1214     child_ns.'add_namespace'( 'Grandkid', grandchild_ns )
1215
1216     .local pmc great_grandchild_ns
1217     great_grandchild_ns = new 'NameSpace'
1218     grandchild_ns.'add_namespace'( 'Greatgrandkid', great_grandchild_ns )
1219
1220     .local pmc parent
1221     parent = great_grandchild_ns.'get_parent'()
1222     print_ns_name( parent )
1223
1224     parent = parent.'get_parent'()
1225     print_ns_name( parent )
1226
1227     parent = parent.'get_parent'()
1228     print_ns_name( parent )
1229 .end
1230
1231 .sub print_ns_name
1232     .param pmc namespace
1233
1234     .local pmc ns
1235     ns = namespace.'get_name'()
1236
1237     .local string ns_name
1238     ns_name = join ';', ns
1239     print ns_name
1240     print "\\n"
1241 .end
1242 CODE
1243 parrot;Nested;Grandkid
1244 parrot;Nested
1245 parrot
1246 OUTPUT
1247
1248 pir_output_like( <<'CODE', <<'OUTPUT', 'add_namespace() with error' );
1249 .sub main :main
1250     .local pmc ns_child
1251     ns_child = subclass 'NameSpace', 'NSChild'
1252
1253     .local pmc child
1254     child = new 'NSChild'
1255
1256     .local pmc root_ns
1257     root_ns = get_namespace
1258
1259     root_ns.'add_namespace'( 'Really nested', child )
1260
1261     .local pmc not_a_ns
1262     not_a_ns = new 'Integer'
1263
1264     push_eh _invalid_ns
1265     root_ns.'add_namespace'( 'Nested', not_a_ns )
1266     end
1267
1268 _invalid_ns:
1269     .local pmc exception
1270     .local string message
1271     .get_results( exception, message )
1272
1273     print message
1274     print "\n"
1275 .end
1276 CODE
1277 /Invalid type \d+ in add_namespace\(\)/
1278 OUTPUT
1279
1280 pir_output_is( <<"CODE", <<'OUTPUT', 'add_sub()' );
1281 $create_nested_key
1282
1283 .sub 'main' :main
1284     .local pmc report_ns
1285     report_ns = get_global 'report_namespace'
1286
1287     .local pmc key
1288     key = create_nested_key( 'Parent' )
1289
1290     .local pmc parent_ns
1291     parent_ns = get_namespace key
1292     parent_ns.'add_sub'( 'report_ns', report_ns )
1293
1294     key = create_nested_key( 'Parent', 'Child' )
1295
1296     .local pmc child_ns
1297     child_ns = get_namespace key
1298     child_ns.'add_sub'( 'report_ns', report_ns )
1299
1300     .local pmc report_namespace
1301     report_namespace = get_global [ 'Parent' ], 'report_ns'
1302     report_namespace()
1303
1304     report_namespace = get_global [ 'Parent'; 'Child' ], 'report_ns'
1305     report_namespace()
1306 .end
1307
1308 .sub 'report_namespace'
1309     .local pmc namespace
1310     namespace = get_namespace
1311
1312     .local pmc ns
1313     ns = namespace.'get_name'()
1314
1315     .local string ns_name
1316     ns_name = join ';', ns
1317     print ns_name
1318     print "\\n"
1319 .end
1320
1321 .namespace [ 'Parent' ]
1322
1323 .sub dummy
1324 .end
1325
1326 .namespace [ 'Parent'; 'Child' ]
1327
1328 .sub dummy
1329 .end
1330 CODE
1331 parrot
1332 parrot
1333 OUTPUT
1334
1335 pir_error_output_like( <<'CODE', <<'OUTPUT', 'add_sub() with error', todo => 'needs full implementation of PDD 17' );
1336 .sub main :main
1337     .local pmc s_child
1338     s_child = subclass 'Sub', 'SubChild'
1339
1340     .local pmc e_child
1341     e_child = subclass 'Closure', 'ClosureChild'
1342
1343     .local pmc child
1344     child = new 'SubChild'
1345
1346     .local pmc root_ns
1347     root_ns = get_namespace
1348
1349     root_ns.'add_sub'( 'child', child )
1350     print "Added sub child\n"
1351
1352     child = new 'Closure'
1353     root_ns.'add_sub'( 'closure', child )
1354     print "Added closure\n"
1355
1356     child = new 'Coroutine'
1357     root_ns.'add_sub'( 'coroutine', child )
1358     print "Added coroutine\n"
1359
1360     child = new 'Eval'
1361     root_ns.'add_sub'( 'eval', child )
1362     print "Added eval\n"
1363
1364     child = new 'ClosureChild'
1365     root_ns.'add_sub'( 'closure_child', child )
1366     print "Added closure child\n"
1367
1368     .local pmc not_a_sub
1369     not_a_sub = new 'Integer'
1370
1371     push_eh _invalid_sub
1372     root_ns.'add_sub'( 'Nested', not_a_sub )
1373     end
1374
1375 _invalid_sub:
1376     .local pmc exception
1377     .local string message
1378     .get_results( exception, message )
1379
1380     print message
1381     print "\n"
1382 .end
1383 CODE
1384 /Added sub child
1385 Added closure
1386 Added coroutine
1387 Added eval
1388 Added closure child
1389 Invalid type \d+ in add_sub\(\)/
1390 OUTPUT
1391
1392 pir_output_is( <<"CODE", <<'OUTPUT', 'add_var()' );
1393 $create_nested_key
1394
1395 .sub 'main' :main
1396     .local pmc foo
1397     foo = new 'String'
1398     foo = 'Foo'
1399
1400     .local pmc bar
1401     bar = new 'String'
1402     bar = 'Bar'
1403
1404     .local pmc key
1405     key = create_nested_key( 'Parent' )
1406
1407     .local pmc parent_ns
1408     parent_ns = get_namespace key
1409     parent_ns.'add_var'( 'foo', foo )
1410
1411     key = create_nested_key( 'Parent', 'Child' )
1412
1413     .local pmc child_ns
1414     child_ns = get_namespace key
1415     child_ns.'add_var'( 'bar', bar )
1416
1417     .local pmc my_var
1418     my_var = get_global [ 'Parent' ], 'foo'
1419     print "Foo: "
1420     print my_var
1421     print "\\n"
1422
1423     my_var = get_global [ 'Parent'; 'Child' ], 'bar'
1424     print "Bar: "
1425     print my_var
1426     print "\\n"
1427 .end
1428
1429 .namespace [ 'Parent' ]
1430
1431 .sub dummy
1432 .end
1433
1434 .namespace [ 'Parent'; 'Child' ]
1435
1436 .sub dummy
1437 .end
1438 CODE
1439 Foo: Foo
1440 Bar: Bar
1441 OUTPUT
1442
1443 pir_output_is( <<"CODE", <<'OUTPUT', 'del_namespace()' );
1444 $create_nested_key
1445
1446 .sub 'main' :main
1447     .local pmc root_ns
1448     root_ns = get_namespace
1449
1450     .local pmc key
1451     key      = create_nested_key( 'Parent' )
1452
1453     .local pmc child_ns
1454     child_ns = root_ns.'find_namespace'( key )
1455
1456     key      = create_nested_key( 'Child' )
1457
1458     .local pmc grandchild_ns
1459     grandchild_ns = child_ns.'find_namespace'( key )
1460
1461     child_ns.'del_namespace'( 'Child' )
1462
1463     key      = create_nested_key( 'Child' )
1464
1465     .local pmc grandchild_ns
1466     grandchild_ns = child_ns.'find_namespace'( key )
1467     if_null grandchild_ns, CHECK_SIBLING
1468     print "Grandchild still exists\\n"
1469
1470   CHECK_SIBLING:
1471     key      = create_nested_key( 'Sibling' )
1472     grandchild_ns = child_ns.'find_namespace'( key )
1473     if_null grandchild_ns, DELETE_PARENT
1474     print "Sibling not deleted\\n"
1475
1476   DELETE_PARENT:
1477     key      = create_nested_key( 'Parent' )
1478     root_ns.'del_namespace'( 'Parent' )
1479     child_ns = root_ns.'find_namespace'( key )
1480     if_null child_ns, CHECK_UNCLE
1481     print "Child still exists\\n"
1482
1483   CHECK_UNCLE:
1484     key      = create_nested_key( 'FunUncle' )
1485     grandchild_ns = root_ns.'find_namespace'( key )
1486     if_null grandchild_ns, DELETE_PARENT
1487     print "Fun uncle stuck around\\n"
1488
1489   ALL_DONE:
1490 .end
1491
1492 .namespace [ 'FunUncle' ]
1493
1494 .sub dummy
1495 .end
1496
1497 .namespace [ 'Parent' ]
1498
1499 .sub dummy
1500 .end
1501
1502 .namespace [ 'Parent'; 'Child' ]
1503
1504 .sub dummy
1505 .end
1506
1507 .namespace [ 'Parent'; 'Sibling' ]
1508
1509 .sub dummy
1510 .end
1511 CODE
1512 Sibling not deleted
1513 Fun uncle stuck around
1514 OUTPUT
1515
1516 pir_output_like( <<'CODE', <<'OUTPUT', 'del_namespace() with error' );
1517 .sub dummy
1518 .end
1519
1520 .sub main :main
1521     .local pmc not_a_ns
1522     not_a_ns = new 'Array'
1523
1524     set_global 'Not_A_NS', not_a_ns
1525
1526     .local pmc root_ns
1527     root_ns = get_namespace
1528     delete_namespace( root_ns, 'dummy' )
1529     delete_namespace( root_ns, 'Not_A_NS' )
1530 .end
1531
1532 .sub delete_namespace
1533     .param pmc    root_ns
1534     .param string name
1535     push_eh _invalid_ns
1536     root_ns.'del_namespace'( name )
1537
1538 _invalid_ns:
1539     .local pmc exception
1540     .local string message
1541     .get_results( exception, message )
1542
1543     print message
1544     print "\n"
1545     .return()
1546 .end
1547 CODE
1548 /Invalid type \d+ for 'dummy' in del_namespace\(\)
1549 Invalid type \d+ for 'Not_A_NS' in del_namespace\(\)/
1550 OUTPUT
1551
1552 pir_output_is( <<"CODE", <<'OUTPUT', 'del_sub()' );
1553 .sub 'main' :main
1554     .local pmc root_ns
1555     root_ns = get_namespace
1556
1557     .local pmc parent_ns
1558     parent_ns = root_ns.'find_namespace'( 'Parent' )
1559     parent_ns.'del_sub'( 'dummy' )
1560
1561     .local pmc my_sub
1562     my_sub = get_global [ 'Parent' ], 'dummy'
1563     if_null my_sub, PARENT_NO_DUMMY
1564     print "Parent did not delete dummy\\n"
1565
1566   PARENT_NO_DUMMY:
1567     my_sub = get_global [ 'Parent' ], 'no_dummy'
1568     my_sub()
1569
1570     .local pmc child_ns
1571     child_ns = parent_ns.'find_namespace'( 'Child' )
1572     child_ns.'del_sub'( 'dummy' )
1573
1574     .local pmc my_sub
1575     my_sub = get_global [ 'Parent'; 'Child' ], 'dummy'
1576     if_null my_sub, CHILD_NO_DUMMY
1577     print "Child did not delete dummy\\n"
1578     my_sub()
1579
1580   CHILD_NO_DUMMY:
1581     my_sub = get_global [ 'Parent'; 'Child' ], 'no_dummy'
1582     my_sub()
1583 .end
1584
1585 .namespace [ 'Parent' ]
1586
1587 .sub dummy
1588 .end
1589
1590 .sub no_dummy
1591     print "Parent is no dummy\\n"
1592 .end
1593
1594 .namespace [ 'Parent'; 'Child' ]
1595
1596 .sub dummy
1597     print "Dummy sub!\\n"
1598 .end
1599
1600 .sub no_dummy
1601     print "Child is no dummy\\n"
1602 .end
1603
1604 CODE
1605 Parent is no dummy
1606 Child is no dummy
1607 OUTPUT
1608
1609 pir_output_like( <<'CODE', <<'OUTPUT', 'del_sub() with error' );
1610 .sub main :main
1611     .local pmc not_a_ns
1612     not_a_ns = new 'Array'
1613
1614     set_global 'Not_A_Sub', not_a_ns
1615
1616     .local pmc root_ns
1617     root_ns = get_namespace
1618
1619     push_eh _invalid_sub
1620     root_ns.'del_sub'( 'Not_A_Sub' )
1621
1622 _invalid_sub:
1623     .local pmc exception
1624     .local string message
1625     .get_results( exception, message )
1626
1627     print message
1628     print "\n"
1629     .return()
1630 .end
1631 CODE
1632 /Invalid type \d+ for 'Not_A_Sub' in del_sub\(\)/
1633 OUTPUT
1634
1635 pir_output_is( <<"CODE", <<'OUTPUT', 'del_var()' );
1636 .sub 'main' :main
1637     .local pmc foo
1638     foo = new 'String'
1639     foo = 'Foo'
1640
1641     .local pmc bar
1642     bar = new 'String'
1643     bar = 'Bar'
1644
1645     set_global [ 'Parent' ],          'Foo', foo
1646     set_global [ 'Parent'; 'Child' ], 'Bar', bar
1647
1648     .local pmc root_ns
1649     root_ns = get_namespace
1650
1651     .local pmc parent_ns
1652     parent_ns = root_ns.'find_namespace'( 'Parent' )
1653     parent_ns.'del_var'( 'Foo' )
1654
1655     .local pmc child_ns
1656     child_ns = parent_ns.'find_namespace'( 'Child' )
1657     child_ns.'del_var'( 'Bar' )
1658
1659     .local pmc my_var
1660     my_var = get_global [ 'Parent' ], 'Foo'
1661     if_null my_var, TEST_CHILD_VAR
1662     print "Parent Foo exists: "
1663     print my_var
1664     print "\\n"
1665
1666   TEST_CHILD_VAR:
1667     my_var = get_global [ 'Parent'; 'Child' ], 'Bar'
1668     if_null my_var, ALL_DONE
1669     print "Child Bar exists: "
1670     print my_var
1671     print "\\n"
1672
1673   ALL_DONE:
1674 .end
1675
1676 .namespace [ 'Parent' ]
1677
1678 .sub dummy
1679 .end
1680
1681 .namespace [ 'Parent'; 'Child' ]
1682
1683 CODE
1684 OUTPUT
1685
1686 pir_error_output_like( <<'CODE', <<'OUTPUT', 'overriding find_method()' );
1687 .sub 'main' :main
1688     $P0 = newclass 'Override'
1689     $P1 = new 'Override'
1690     $P2 = find_method $P1, 'foo'
1691 .end
1692
1693 .namespace [ 'Override' ]
1694
1695 .sub 'find_method' :vtable
1696     say "Finding method"
1697 .end
1698 CODE
1699 /Finding method/
1700 OUTPUT
1701
1702 pir_output_is( <<'CODE', <<OUT, "iterate through a NameSpace PMC, RT #39978" );
1703 .sub main :main
1704      $P0 = new 'String'
1705      $P0 = "Ook...BANG!\n"
1706      set_root_global [ "DUMMY"; "X"; "Y" ], "Explosion", $P0
1707
1708      $P1 = new 'Integer'
1709      $P1 = 0
1710      set_root_global [ "DUMMY"; "X"; "Y" ], "T0", $P0
1711
1712      .local pmc dummy_x_y_ns, iter
1713      dummy_x_y_ns = get_root_namespace [ "DUMMY"; "X"; "Y" ]
1714      iter = new 'Iterator', dummy_x_y_ns
1715 loop:
1716      unless iter goto loop_end
1717      $S0 = shift iter
1718      print $S0
1719      print "\n"
1720      goto loop
1721 loop_end:
1722
1723 .end
1724 CODE
1725 Explosion
1726 T0
1727 OUT
1728
1729 pir_error_output_like( <<'CODE', <<OUT, "NameSpace with no class, RT #55620" );
1730 .sub 'main' :main
1731     $P1 = new 'NameSpace'
1732     set_args '(0)', $P1
1733     tailcallmethod $P1, 'bob'
1734 .end
1735 CODE
1736 /Null PMC access in get_string()/
1737 OUT
1738
1739 pir_output_is( <<'CODE', <<OUT, "iterate through a NameSpace PMC" );
1740 .namespace [ 'bar' ]
1741
1742 .sub 'main' :main
1743     $P0 = get_namespace
1744     say $P0
1745     $I0 = elements $P0
1746     say $I0
1747     new $P1 , 'Iterator', $P0
1748   L1:
1749     unless $P1 goto L2
1750     $P2 = shift $P1
1751     say $P2
1752     goto L1
1753   L2:
1754     say 'OK'
1755 .end
1756
1757 .sub 'foo'
1758     say 'foo'
1759 .end
1760 CODE
1761 bar
1762 2
1763 main
1764 foo
1765 OK
1766 OUT
1767
1768
1769 # Local Variables:
1770 #   mode: cperl
1771 #   cperl-indent-level: 4
1772 #   fill-column: 100
1773 # End:
1774 # vim: expandtab shiftwidth=4: