t/pmc/namespace-old.t

   1 #! perl
   2 # Copyright (C) 2001-2009, 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 => 38;
  10 use Parrot::Config;
  11
  12 =head1 NAME
  13
  14 t/pmc/namespace.t - test the NameSpace PMC as described in PDD 21.
  15
  16 =head1 SYNOPSIS
  17
  18     % prove t/pmc/namespace-old.t
  19
  20 =head1 DESCRIPTION
  21
  22 Test the NameSpace PMC as described in PDD21.
  23
  24 =cut
  25
  26 my $temp_a = "temp_a";
  27 my $temp_b = "temp_b";
  28
  29 END {
  30     unlink( "$temp_a.pir", "$temp_a.pbc", "$temp_b.pir", "$temp_b.pbc" );
  31 }
  32
  33 open my $S, '>', "$temp_a.pir" or die "Can't write $temp_a.pir";
  34 print $S <<'EOF';
  35 .HLL "Foo"
  36 .namespace ["Foo_A"]
  37 .sub loada :load
  38     $P0 = get_global ["Foo_A"], "A"
  39     print "ok 1\n"
  40     load_bytecode "temp_b.pbc"
  41 .end
  42
  43 .sub A
  44 .end
  45 EOF
  46 close $S;
  47
  48 open $S, '>', "$temp_b.pir" or die "Can't write $temp_b.pir";
  49 print $S <<'EOF';
  50 .namespace ["Foo_B"]
  51 .sub loadb :load
  52     $P0 = get_global ["Foo_B"], "B"
  53     print "ok 2\n"
  54 .end
  55
  56 .sub B
  57 .end
  58 EOF
  59
  60 close $S;
  61
  62 system(".$PConfig{slash}parrot$PConfig{exe} -o $temp_a.pbc $temp_a.pir");
  63 system(".$PConfig{slash}parrot$PConfig{exe} -o $temp_b.pbc $temp_b.pir");
  64
  65 pir_output_is( <<'CODE', <<'OUTPUT', "HLL and load_bytecode - #38888" );
  66 .sub main :main
  67     load_bytecode "temp_a.pbc"
  68     print "ok 3\n"
  69 .end
  70 CODE
  71 ok 1
  72 ok 2
  73 ok 3
  74 OUTPUT
  75
  76 pir_output_is( <<'CODE', <<'OUTPUT', "HLL and vars" );
  77 # initial storage of _tcl global variable...
  78
  79 .HLL '_Tcl'
  80
  81 .sub huh
  82   $P0 = new ['Integer']
  83   $P0 = 3.14
  84   set_global '$variable', $P0
  85 .end
  86
  87 # start running HLL language
  88 .HLL 'Tcl'
  89
  90 .sub foo :main
  91   huh()
  92   $P1 = get_root_namespace ['_tcl']
  93   $P2 = $P1['$variable']
  94   print $P2
  95   print "\n"
  96 .end
  97 CODE
  98 3.14
  99 OUTPUT
 100
 101 pir_output_is( <<'CODE', <<'OUTPUT', "HLL and namespace directives" );
 102 .HLL '_Tcl'
 103 .namespace ['Foo'; 'Bar']
 104
 105 .HLL 'Tcl'
 106
 107 .sub main :main
 108   $P0 = get_namespace
 109   $P1 = $P0.'get_name'()
 110   $S0 = join "::", $P1
 111   print $S0
 112   print "\n"
 113   end
 114 .end
 115 CODE
 116 tcl
 117 OUTPUT
 118
 119 {
 120     my $temp_a = "temp_a.pir";
 121
 122     END {
 123         unlink($temp_a);
 124     }
 125
 126     open $S, '>', $temp_a or die "Can't write $temp_a";
 127     print $S <<'EOF';
 128 .HLL 'eek'
 129
 130 .sub foo :load :anon
 131   $P1 = new ['String']
 132   $P1 = "3.14\n"
 133   set_global '$whee', $P1
 134 .end
 135
 136 .sub bark
 137   $P0 = get_global '$whee'
 138   print $P0
 139 .end
 140 EOF
 141     close $S;
 142
 143     pir_output_is( <<'CODE', <<'OUTPUT', ":anon subs still get default namespace" );
 144 .HLL 'cromulent'
 145
 146 .sub what
 147    load_bytecode 'temp_a.pir'
 148   .local pmc var
 149    var = get_root_namespace
 150    var = var['eek']
 151    var = var['bark']
 152
 153     var()
 154 .end
 155 CODE
 156 3.14
 157 OUTPUT
 158 }
 159
 160 SKIP:
 161 {
 162     skip( "immediate test, doesn't with --run-pbc", 1 )
 163         if ( exists $ENV{TEST_PROG_ARGS} and $ENV{TEST_PROG_ARGS} =~ m/--run-pbc/ );
 164
 165     pir_output_is( <<'CODE', <<'OUTPUT', "get_global in current" );
 166 .HLL 'bork'
 167 .namespace []
 168
 169 .sub a :immediate
 170   $P1 = new ['String']
 171   $P1 = "ok\n"
 172   set_global ['sub_namespace'], "eek", $P1
 173 .end
 174
 175 .namespace [ 'sub_namespace' ]
 176
 177 .sub whee :main
 178  $P1 = get_global 'eek'
 179  print $P1
 180 .end
 181 CODE
 182 ok
 183 OUTPUT
 184 }
 185
 186 open $S, '>', "$temp_b.pir" or die "Can't write $temp_b.pir";
 187 print $S <<'EOF';
 188 .HLL 'B'
 189 .sub b_foo
 190     print "b_foo\n"
 191 .end
 192 EOF
 193 close $S;
 194
 195 pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with array" );
 196 .HLL 'A'
 197 .sub main :main
 198     a_foo()
 199     load_bytecode "$temp_b.pir"
 200     .local pmc nsr, nsa, nsb, ar
 201     ar = new ['ResizableStringArray']
 202     push ar, "b_foo"
 203     nsr = get_root_namespace
 204     nsa = nsr['a']
 205     nsb = nsr['b']
 206     nsb."export_to"(nsa, ar)
 207     b_foo()
 208 .end
 209
 210 .sub a_foo
 211     print "a_foo\\n"
 212 .end
 213 CODE
 214 a_foo
 215 b_foo
 216 OUTPUT
 217
 218 pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with hash (empty value)" );
 219 .HLL 'A'
 220 .sub main :main
 221     a_foo()
 222     load_bytecode "$temp_b.pir"
 223     .local pmc nsr, nsa, nsb, ar
 224     ar = new ['Hash']
 225     ar["b_foo"] = ""
 226     nsr = get_root_namespace
 227     nsa = nsr['a']
 228     nsb = nsr['b']
 229     nsb."export_to"(nsa, ar)
 230     b_foo()
 231 .end
 232
 233 .sub a_foo
 234     print "a_foo\\n"
 235 .end
 236 CODE
 237 a_foo
 238 b_foo
 239 OUTPUT
 240
 241 pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with hash (null value)" );
 242 .HLL 'A'
 243 .sub main :main
 244     a_foo()
 245     load_bytecode "$temp_b.pir"
 246     .local pmc nsr, nsa, nsb, ar, nul
 247     nul = new ['Null']
 248     ar  = new ['Hash']
 249     ar["b_foo"] = nul
 250     nsr = get_root_namespace
 251     nsa = nsr['a']
 252     nsb = nsr['b']
 253     nsb."export_to"(nsa, ar)
 254     b_foo()
 255 .end
 256
 257 .sub a_foo
 258     print "a_foo\\n"
 259 .end
 260 CODE
 261 a_foo
 262 b_foo
 263 OUTPUT
 264
 265 pir_error_output_like( <<"CODE", <<'OUTPUT', "export_to -- success with hash (and value)" );
 266 .HLL 'A'
 267 .sub main :main
 268     a_foo()
 269     load_bytecode "$temp_b.pir"
 270     .local pmc nsr, nsa, nsb, ar
 271     ar = new ['Hash']
 272     ar["b_foo"] = "c_foo"
 273     nsr = get_root_namespace
 274     nsa = nsr['a']
 275     nsb = nsr['b']
 276     nsb."export_to"(nsa, ar)
 277     c_foo()
 278     b_foo()
 279 .end
 280
 281 .sub a_foo
 282     print "a_foo\\n"
 283 .end
 284 CODE
 285 /^a_foo
 286 b_foo
 287 Could not find sub b_foo/
 288 OUTPUT
 289
 290
 291 pir_output_is( <<'CODE', <<'OUTPUT', "get_parent" );
 292 .sub main :main
 293     .local pmc ns
 294     ns = get_hll_namespace ['Foo']
 295     ns = ns.'get_parent'()
 296     print ns
 297     print "\n"
 298 .end
 299 .namespace ['Foo']
 300 .sub dummy
 301 .end
 302 CODE
 303 parrot
 304 OUTPUT
 305
 306 pir_output_is( <<'CODE', <<'OUTPUT', "get_global [''], \"print_ok\"" );
 307 .namespace ['']
 308
 309 .sub print_ok
 310   print "ok\n"
 311   .return()
 312 .end
 313
 314 .namespace ['foo']
 315
 316 .sub main :main
 317   $P0 = get_hll_global [''], 'print_ok'
 318   $P0()
 319   end
 320 .end
 321 CODE
 322 ok
 323 OUTPUT
 324
 325 pir_output_is( <<'CODE', <<'OUTPUT', "get_global with array ('')" );
 326 .namespace ['']
 327
 328 .sub print_ok
 329   print "ok\n"
 330   .return()
 331 .end
 332
 333 .namespace ['foo']
 334
 335 .sub main :main
 336   $P0 = new ['ResizableStringArray']
 337   $P0[0] = ''
 338   $P0 = get_hll_global $P0, 'print_ok'
 339   $P0()
 340   end
 341 .end
 342 CODE
 343 ok
 344 OUTPUT
 345
 346 pir_output_is( <<'CODE', <<'OUTPUT', "get_global with empty array" );
 347 .namespace []
 348
 349 .sub print_ok
 350   print "ok\n"
 351   .return()
 352 .end
 353
 354 .namespace ['foo']
 355
 356 .sub main :main
 357   $P0 = new ['ResizablePMCArray']
 358   $P0 = 0
 359   $P0 = get_hll_global $P0, 'print_ok'
 360   $P0()
 361   end
 362 .end
 363 CODE
 364 ok
 365 OUTPUT
 366
 367 pir_output_is( <<'CODE', <<'OUTPUT', "Namespace.get_global() with array ('')" );
 368 .namespace ['']
 369
 370 .sub print_ok
 371   print "ok\n"
 372   .return()
 373 .end
 374
 375 .namespace ['foo']
 376
 377 .sub main :main
 378   $P1 = new ['ResizableStringArray']
 379   $P1[0] = ''
 380   $P1 = get_hll_global $P1, 'print_ok'
 381   $P1()
 382   end
 383 .end
 384 CODE
 385 ok
 386 OUTPUT
 387
 388 pir_output_is( <<'CODE', <<'OUTPUT', "Namespace introspection" );
 389 .sub main :main
 390     .local pmc f
 391     f = get_hll_global ['Foo'], 'dummy'
 392     f()
 393 .end
 394 .namespace ['Foo']
 395 .sub dummy
 396     .local pmc interp, ns_caller
 397     interp = getinterp
 398     ns_caller = interp['namespace'; 1]
 399     print ns_caller
 400     print "\n"
 401 .end
 402 CODE
 403 parrot
 404 OUTPUT
 405
 406 pir_output_is( <<'CODE', <<'OUTPUT', "Nested namespace introspection" );
 407 .sub main :main
 408     .local string no_symbol
 409
 410     .local pmc foo_ns
 411     foo_ns = get_hll_namespace [ 'Foo' ]
 412     $S0    = foo_ns
 413     print "Found namespace: "
 414     print $S0
 415     print "\n"
 416
 417     .local pmc bar_ns
 418     bar_ns = foo_ns.'find_namespace'( 'Bar' )
 419     $S0    = bar_ns
 420     print "Found nested namespace: "
 421     print $S0
 422     print "\n"
 423
 424     .local pmc baz_ns
 425     baz_ns    = bar_ns.'find_namespace'( 'Baz' )
 426     no_symbol = 'Baz'
 427
 428     .local int is_defined
 429     is_defined = defined baz_ns
 430     if is_defined goto oops
 431     goto find_symbols
 432
 433   oops:
 434     print "Found non-null '"
 435     print no_symbol
 436     print "'\n"
 437     .return()
 438
 439   find_symbols:
 440     .local pmc a_sub
 441     a_sub = bar_ns.'find_sub'( 'a_sub' )
 442     $S0   = a_sub
 443     a_sub()
 444     print "Found sub: "
 445     print $S0
 446     print "\n"
 447
 448     .local pmc some_sub
 449     some_sub  = bar_ns.'find_sub'( 'some_sub' )
 450     no_symbol = 'some_sub'
 451
 452     is_defined = defined some_sub
 453     if is_defined goto oops
 454
 455     .local pmc a_var
 456     a_var    = bar_ns.'find_var'( 'a_var' )
 457     print "Found var: "
 458     print a_var
 459     print "\n"
 460
 461     .local pmc some_var
 462     some_var    = bar_ns.'find_var'( 'some_var' )
 463     no_symbol = 'some_var'
 464
 465     is_defined = defined some_var
 466     if is_defined goto oops
 467
 468 .end
 469
 470 .namespace ['Foo']
 471
 472 .sub some_sub
 473 .end
 474
 475 .namespace [ 'Foo'; 'Bar' ]
 476
 477 .sub a_sub
 478     .local pmc some_var
 479     some_var = new ['String']
 480     some_var = 'a string PMC'
 481     set_hll_global [ 'Foo'; 'Bar' ], 'a_var', some_var
 482 .end
 483 CODE
 484 Found namespace: Foo
 485 Found nested namespace: Bar
 486 Found sub: a_sub
 487 Found var: a string PMC
 488 OUTPUT
 489
 490 pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace' );
 491 .sub main :main
 492     .local pmc root_ns
 493     root_ns = get_root_namespace
 494     .local int is_defined
 495     is_defined = defined root_ns
 496     unless is_defined goto NO_NAMESPACE_FOUND
 497         print "Found root namespace.\n"
 498     NO_NAMESPACE_FOUND:
 499 .end
 500 CODE
 501 Found root namespace.
 502 OUTPUT
 503
 504 pir_output_is( <<'CODE', <<'OUTPUT', 'root namespace is not a class' );
 505 .sub main :main
 506     .local pmc root_ns
 507     root_ns = get_root_namespace
 508     .local pmc root_class
 509     root_class = get_class root_ns
 510     .local int is_class
 511     is_class = defined root_class
 512     say is_class
 513 .end
 514 CODE
 515 0
 516 OUTPUT
 517
 518 pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace "Foo"' );
 519 .sub main :main
 520     .local pmc foo_ns
 521     foo_ns = get_root_namespace [ "foo" ]
 522     .local int is_defined
 523     is_defined = defined foo_ns
 524     unless is_defined goto NO_NAMESPACE_FOUND
 525         print "Found root namespace 'foo'.\n"
 526     NO_NAMESPACE_FOUND:
 527 .end
 528 .HLL 'Foo'
 529 .sub dummy
 530 .end
 531 CODE
 532 Found root namespace 'foo'.
 533 OUTPUT
 534
 535 pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace "Foo", not there' );
 536 .sub main :main
 537     .local pmc foo_ns
 538     foo_ns = get_root_namespace [ "Foo" ]
 539     .local int is_defined
 540     is_defined = defined foo_ns
 541     if is_defined goto NAMESPACE_FOUND
 542         print "Didn't find root namespace 'Foo'.\n"
 543     NAMESPACE_FOUND:
 544 .end
 545
 546 .namespace [ "NotFoo" ]
 547 CODE
 548 Didn't find root namespace 'Foo'.
 549 OUTPUT
 550
 551 my $create_nested_key = <<'CREATE_NESTED_KEY';
 552 .sub create_nested_key
 553     .param string name
 554     .param pmc other_names :slurpy
 555
 556     .local pmc key
 557     key = new ['Key']
 558     key = name
 559
 560     .local int elem
 561     elem = other_names
 562
 563     if elem goto nested
 564     .return( key )
 565
 566   nested:
 567     .local pmc tail
 568     tail = create_nested_key(other_names :flat)
 569     push key, tail
 570
 571     .return( key )
 572 .end
 573 CREATE_NESTED_KEY
 574
 575 pir_output_is( <<"CODE", <<'OUTPUT', 'get_name()' );
 576 $create_nested_key
 577
 578 .sub main :main
 579     .local pmc key
 580     key = create_nested_key( 'SingleName' )
 581     print_namespace( key )
 582
 583     key = create_nested_key( 'Nested', 'Name', 'Space' )
 584     print_namespace( key )
 585
 586     key = get_namespace
 587
 588     .local pmc ns
 589     ns = key.'get_name'()
 590
 591     .local string ns_name
 592     ns_name = join ';', ns
 593     print ns_name
 594     print "\\n"
 595 .end
 596
 597 .sub 'print_namespace'
 598     .param pmc key
 599
 600     .local pmc get_ns
 601     get_ns = get_global key, 'get_namespace'
 602
 603     .local pmc ns
 604     ns = get_ns()
 605
 606     .local pmc name_array
 607     name_array = ns.'get_name'()
 608
 609     .local string name
 610     name = join ';', name_array
 611
 612     print name
 613     print "\\n"
 614 .end
 615
 616 .sub get_namespace
 617     .local pmc ns
 618     ns = get_namespace
 619     .return( ns )
 620 .end
 621
 622 .namespace [ 'SingleName' ]
 623
 624 .sub get_namespace
 625     .local pmc ns
 626     ns = get_namespace
 627     .return( ns )
 628 .end
 629
 630 .namespace [ 'Nested'; 'Name'; 'Space' ]
 631
 632 .sub get_namespace
 633     .local pmc ns
 634     ns = get_namespace
 635     .return( ns )
 636 .end
 637
 638 CODE
 639 parrot;SingleName
 640 parrot;Nested;Name;Space
 641 parrot
 642 OUTPUT
 643
 644 pir_output_is( <<"CODE", <<'OUTPUT', 'add_namespace()' );
 645 $create_nested_key
 646
 647 .sub main :main
 648     .local pmc root_ns
 649     root_ns = get_namespace
 650
 651     .local pmc child_ns
 652     child_ns = new ['NameSpace']
 653     root_ns.'add_namespace'( 'Nested', child_ns )
 654
 655     .local pmc grandchild_ns
 656     grandchild_ns = new ['NameSpace']
 657     child_ns.'add_namespace'( 'Grandkid', grandchild_ns )
 658
 659     .local pmc great_grandchild_ns
 660     great_grandchild_ns = new ['NameSpace']
 661     grandchild_ns.'add_namespace'( 'Greatgrandkid', great_grandchild_ns )
 662
 663     .local pmc parent
 664     parent = great_grandchild_ns.'get_parent'()
 665     print_ns_name( parent )
 666
 667     parent = parent.'get_parent'()
 668     print_ns_name( parent )
 669
 670     parent = parent.'get_parent'()
 671     print_ns_name( parent )
 672 .end
 673
 674 .sub print_ns_name
 675     .param pmc namespace
 676
 677     .local pmc ns
 678     ns = namespace.'get_name'()
 679
 680     .local string ns_name
 681     ns_name = join ';', ns
 682     print ns_name
 683     print "\\n"
 684 .end
 685 CODE
 686 parrot;Nested;Grandkid
 687 parrot;Nested
 688 parrot
 689 OUTPUT
 690
 691 pir_output_like( <<'CODE', <<'OUTPUT', 'add_namespace() with error' );
 692 .sub main :main
 693     .local pmc ns_child
 694     ns_child = subclass 'NameSpace', 'NSChild'
 695
 696     .local pmc child
 697     child = new ['NSChild']
 698
 699     .local pmc root_ns
 700     root_ns = get_namespace
 701
 702     root_ns.'add_namespace'( 'Really nested', child )
 703
 704     .local pmc not_a_ns
 705     not_a_ns = new ['Integer']
 706
 707     push_eh _invalid_ns
 708     root_ns.'add_namespace'( 'Nested', not_a_ns )
 709     end
 710
 711 _invalid_ns:
 712     .local pmc exception
 713     .local string message
 714     .get_results( exception )
 715
 716     message = exception
 717     print message
 718     print "\n"
 719 .end
 720 CODE
 721 /Invalid type \d+ in add_namespace\(\)/
 722 OUTPUT
 723
 724 pir_output_is( <<"CODE", <<'OUTPUT', 'add_sub()' );
 725 $create_nested_key
 726
 727 .sub 'main' :main
 728     .local pmc report_ns
 729     report_ns = get_global 'report_namespace'
 730
 731     .local pmc key
 732     key = create_nested_key( 'Parent' )
 733
 734     .local pmc parent_ns
 735     parent_ns = get_namespace key
 736     parent_ns.'add_sub'( 'report_ns', report_ns )
 737
 738     key = create_nested_key( 'Parent', 'Child' )
 739
 740     .local pmc child_ns
 741     child_ns = get_namespace key
 742     child_ns.'add_sub'( 'report_ns', report_ns )
 743
 744     .local pmc report_namespace
 745     report_namespace = get_global [ 'Parent' ], 'report_ns'
 746     report_namespace()
 747
 748     report_namespace = get_global [ 'Parent'; 'Child' ], 'report_ns'
 749     report_namespace()
 750 .end
 751
 752 .sub 'report_namespace'
 753     .local pmc namespace
 754     namespace = get_namespace
 755
 756     .local pmc ns
 757     ns = namespace.'get_name'()
 758
 759     .local string ns_name
 760     ns_name = join ';', ns
 761     print ns_name
 762     print "\\n"
 763 .end
 764
 765 .namespace [ 'Parent' ]
 766
 767 .sub dummy
 768 .end
 769
 770 .namespace [ 'Parent'; 'Child' ]
 771
 772 .sub dummy
 773 .end
 774 CODE
 775 parrot
 776 parrot
 777 OUTPUT
 778
 779 pir_output_like( <<'CODE', <<'OUTPUT', 'add_sub() with error' );
 780 .sub main :main
 781     .local pmc s_child
 782     s_child = subclass 'Sub', 'SubChild'
 783
 784     .local pmc child
 785     child = new ['SubChild']
 786
 787     .local pmc root_ns
 788     root_ns = get_namespace
 789
 790     root_ns.'add_sub'( 'child', child )
 791     print "Added sub child\n"
 792
 793     child = new ['Coroutine']
 794     root_ns.'add_sub'( 'coroutine', child )
 795     print "Added coroutine\n"
 796
 797     child = new ['Eval']
 798     root_ns.'add_sub'( 'eval', child )
 799     print "Added eval\n"
 800
 801     .local pmc not_a_sub
 802     not_a_sub = new ['Integer']
 803
 804     push_eh _invalid_sub
 805     root_ns.'add_sub'( 'Nested', not_a_sub )
 806     end
 807
 808 _invalid_sub:
 809     .local pmc exception
 810     .local string message
 811     .get_results( exception )
 812
 813     message = exception
 814     print message
 815     print "\n"
 816 .end
 817 CODE
 818 /Added sub child
 819 Added coroutine
 820 Added eval
 821 Invalid type \d+ in add_sub\(\)/
 822 OUTPUT
 823
 824 pir_output_is( <<"CODE", <<'OUTPUT', 'add_var()' );
 825 $create_nested_key
 826
 827 .sub 'main' :main
 828     .local pmc foo
 829     foo = new ['String']
 830     foo = 'Foo'
 831
 832     .local pmc bar
 833     bar = new ['String']
 834     bar = 'Bar'
 835
 836     .local pmc key
 837     key = create_nested_key( 'Parent' )
 838
 839     .local pmc parent_ns
 840     parent_ns = get_namespace key
 841     parent_ns.'add_var'( 'foo', foo )
 842
 843     key = create_nested_key( 'Parent', 'Child' )
 844
 845     .local pmc child_ns
 846     child_ns = get_namespace key
 847     child_ns.'add_var'( 'bar', bar )
 848
 849     .local pmc my_var
 850     my_var = get_global [ 'Parent' ], 'foo'
 851     print "Foo: "
 852     print my_var
 853     print "\\n"
 854
 855     my_var = get_global [ 'Parent'; 'Child' ], 'bar'
 856     print "Bar: "
 857     print my_var
 858     print "\\n"
 859 .end
 860
 861 .namespace [ 'Parent' ]
 862
 863 .sub dummy
 864 .end
 865
 866 .namespace [ 'Parent'; 'Child' ]
 867
 868 .sub dummy
 869 .end
 870 CODE
 871 Foo: Foo
 872 Bar: Bar
 873 OUTPUT
 874
 875 pir_output_is( <<"CODE", <<'OUTPUT', 'del_namespace()' );
 876 $create_nested_key
 877
 878 .sub 'main' :main
 879     .local pmc root_ns
 880     root_ns = get_namespace
 881
 882     .local pmc key
 883     key      = create_nested_key( 'Parent' )
 884
 885     .local pmc child_ns
 886     child_ns = root_ns.'find_namespace'( key )
 887
 888     key      = create_nested_key( 'Child' )
 889
 890     .local pmc grandchild_ns
 891     grandchild_ns = child_ns.'find_namespace'( key )
 892
 893     child_ns.'del_namespace'( 'Child' )
 894
 895     key      = create_nested_key( 'Child' )
 896
 897     grandchild_ns = child_ns.'find_namespace'( key )
 898     if_null grandchild_ns, CHECK_SIBLING
 899     print "Grandchild still exists\\n"
 900
 901   CHECK_SIBLING:
 902     key      = create_nested_key( 'Sibling' )
 903     grandchild_ns = child_ns.'find_namespace'( key )
 904     if_null grandchild_ns, DELETE_PARENT
 905     print "Sibling not deleted\\n"
 906
 907   DELETE_PARENT:
 908     key      = create_nested_key( 'Parent' )
 909     root_ns.'del_namespace'( 'Parent' )
 910     child_ns = root_ns.'find_namespace'( key )
 911     if_null child_ns, CHECK_UNCLE
 912     print "Child still exists\\n"
 913
 914   CHECK_UNCLE:
 915     key      = create_nested_key( 'FunUncle' )
 916     grandchild_ns = root_ns.'find_namespace'( key )
 917     if_null grandchild_ns, DELETE_PARENT
 918     print "Fun uncle stuck around\\n"
 919
 920   ALL_DONE:
 921 .end
 922
 923 .namespace [ 'FunUncle' ]
 924
 925 .sub dummy
 926 .end
 927
 928 .namespace [ 'Parent' ]
 929
 930 .sub dummy
 931 .end
 932
 933 .namespace [ 'Parent'; 'Child' ]
 934
 935 .sub dummy
 936 .end
 937
 938 .namespace [ 'Parent'; 'Sibling' ]
 939
 940 .sub dummy
 941 .end
 942 CODE
 943 Sibling not deleted
 944 Fun uncle stuck around
 945 OUTPUT
 946
 947 pir_output_like( <<'CODE', <<'OUTPUT', 'del_namespace() with error' );
 948 .sub dummy
 949 .end
 950
 951 .sub main :main
 952     .local pmc not_a_ns
 953     not_a_ns = new ['ResizablePMCArray']
 954
 955     set_global 'Not_A_NS', not_a_ns
 956
 957     .local pmc root_ns
 958     root_ns = get_namespace
 959     delete_namespace( root_ns, 'dummy' )
 960     delete_namespace( root_ns, 'Not_A_NS' )
 961 .end
 962
 963 .sub delete_namespace
 964     .param pmc    root_ns
 965     .param string name
 966     push_eh _invalid_ns
 967     root_ns.'del_namespace'( name )
 968
 969 _invalid_ns:
 970     .local pmc exception
 971     .local string message
 972     .get_results( exception )
 973
 974     message = exception
 975     print message
 976     print "\n"
 977     .return()
 978 .end
 979 CODE
 980 /Invalid type \d+ for 'dummy' in del_namespace\(\)
 981 Invalid type \d+ for 'Not_A_NS' in del_namespace\(\)/
 982 OUTPUT
 983
 984 pir_output_is( <<"CODE", <<'OUTPUT', 'del_sub()' );
 985 .sub 'main' :main
 986     .local pmc root_ns
 987     root_ns = get_namespace
 988
 989     .local pmc parent_ns
 990     parent_ns = root_ns.'find_namespace'( 'Parent' )
 991     parent_ns.'del_sub'( 'dummy' )
 992
 993     .local pmc my_sub
 994     my_sub = get_global [ 'Parent' ], 'dummy'
 995     if_null my_sub, PARENT_NO_DUMMY
 996     print "Parent did not delete dummy\\n"
 997
 998   PARENT_NO_DUMMY:
 999     my_sub = get_global [ 'Parent' ], 'no_dummy'
1000     my_sub()
1001
1002     .local pmc child_ns
1003     child_ns = parent_ns.'find_namespace'( 'Child' )
1004     child_ns.'del_sub'( 'dummy' )
1005
1006     my_sub = get_global [ 'Parent'; 'Child' ], 'dummy'
1007     if_null my_sub, CHILD_NO_DUMMY
1008     print "Child did not delete dummy\\n"
1009     my_sub()
1010
1011   CHILD_NO_DUMMY:
1012     my_sub = get_global [ 'Parent'; 'Child' ], 'no_dummy'
1013     my_sub()
1014 .end
1015
1016 .namespace [ 'Parent' ]
1017
1018 .sub dummy
1019 .end
1020
1021 .sub no_dummy
1022     print "Parent is no dummy\\n"
1023 .end
1024
1025 .namespace [ 'Parent'; 'Child' ]
1026
1027 .sub dummy
1028     print "Dummy sub!\\n"
1029 .end
1030
1031 .sub no_dummy
1032     print "Child is no dummy\\n"
1033 .end
1034
1035 CODE
1036 Parent is no dummy
1037 Child is no dummy
1038 OUTPUT
1039
1040 pir_output_like( <<'CODE', <<'OUTPUT', 'del_sub() with error' );
1041 .sub main :main
1042     .local pmc not_a_ns
1043     not_a_ns = new ['ResizablePMCArray']
1044
1045     set_global 'Not_A_Sub', not_a_ns
1046
1047     .local pmc root_ns
1048     root_ns = get_namespace
1049
1050     push_eh _invalid_sub
1051     root_ns.'del_sub'( 'Not_A_Sub' )
1052
1053 _invalid_sub:
1054     .local pmc exception
1055     .local string message
1056     .get_results( exception )
1057
1058     message = exception
1059     print message
1060     print "\n"
1061     .return()
1062 .end
1063 CODE
1064 /Invalid type \d+ for 'Not_A_Sub' in del_sub\(\)/
1065 OUTPUT
1066
1067 pir_output_is( <<"CODE", <<'OUTPUT', 'del_var()' );
1068 .sub 'main' :main
1069     .local pmc foo
1070     foo = new ['String']
1071     foo = 'Foo'
1072
1073     .local pmc bar
1074     bar = new ['String']
1075     bar = 'Bar'
1076
1077     set_global [ 'Parent' ],          'Foo', foo
1078     set_global [ 'Parent'; 'Child' ], 'Bar', bar
1079
1080     .local pmc root_ns
1081     root_ns = get_namespace
1082
1083     .local pmc parent_ns
1084     parent_ns = root_ns.'find_namespace'( 'Parent' )
1085     parent_ns.'del_var'( 'Foo' )
1086
1087     .local pmc child_ns
1088     child_ns = parent_ns.'find_namespace'( 'Child' )
1089     child_ns.'del_var'( 'Bar' )
1090
1091     .local pmc my_var
1092     my_var = get_global [ 'Parent' ], 'Foo'
1093     if_null my_var, TEST_CHILD_VAR
1094     print "Parent Foo exists: "
1095     print my_var
1096     print "\\n"
1097
1098   TEST_CHILD_VAR:
1099     my_var = get_global [ 'Parent'; 'Child' ], 'Bar'
1100     if_null my_var, ALL_DONE
1101     print "Child Bar exists: "
1102     print my_var
1103     print "\\n"
1104
1105   ALL_DONE:
1106 .end
1107
1108 .namespace [ 'Parent' ]
1109
1110 .sub dummy
1111 .end
1112
1113 .namespace [ 'Parent'; 'Child' ]
1114
1115 CODE
1116 OUTPUT
1117
1118 pir_error_output_like( <<'CODE', <<'OUTPUT', 'overriding find_method()' );
1119 .sub 'main' :main
1120     $P0 = newclass 'Override'
1121     $P1 = new ['Override']
1122     $P2 = find_method $P1, 'foo'
1123 .end
1124
1125 .namespace [ 'Override' ]
1126
1127 .sub 'find_method' :vtable
1128     .param string method
1129     say "Finding method"
1130 .end
1131 CODE
1132 /Finding method/
1133 OUTPUT
1134
1135 pir_output_is( <<'CODE', <<OUT, "iterate through a NameSpace PMC" );
1136 .sub main :main
1137      $P0 = new ['String']
1138      $P0 = "Ook...BANG!\n"
1139      set_root_global [ "DUMMY"; "X"; "Y" ], "Explosion", $P0
1140
1141      $P1 = new ['Integer']
1142      $P1 = 0
1143      set_root_global [ "DUMMY"; "X"; "Y" ], "T0", $P0
1144
1145      .local pmc dummy_x_y_ns, it, res
1146      dummy_x_y_ns = get_root_namespace [ "DUMMY"; "X"; "Y" ]
1147      it   = iter dummy_x_y_ns
1148      res  = new ['ResizablePMCArray']
1149 loop:
1150      unless it goto loop_end
1151      $S0 = shift it
1152      push res, $S0
1153      goto loop
1154 loop_end:
1155
1156      res.'sort'()
1157      $S0 = join ' ', res
1158      say $S0
1159
1160 .end
1161 CODE
1162 Explosion T0
1163 OUT
1164
1165 pir_error_output_like( <<'CODE', <<OUT, "NameSpace with no class" );
1166 .sub 'main' :main
1167     $P1 = new ['NameSpace']
1168     set_args '(0)', $P1
1169     tailcallmethod $P1, 'bob'
1170 .end
1171 CODE
1172 /Null PMC access in get_string()/
1173 OUT
1174
1175 pir_output_is( <<'CODE', <<OUT, "iterate through a NameSpace PMC" );
1176 .namespace [ 'bar' ]
1177
1178 .sub 'main' :main
1179     .local pmc res
1180     res = new ['ResizablePMCArray']
1181
1182     $P0 = get_namespace
1183     say $P0
1184     $I0 = elements $P0
1185     say $I0
1186     $P1 = iter $P0
1187   L1:
1188     unless $P1 goto L2
1189     $P2 = shift $P1
1190     $S0 = $P2
1191     push res, $S0
1192     goto L1
1193   L2:
1194     res.'sort'()
1195     $S0 = join "\n", res
1196     say $S0
1197     say 'OK'
1198 .end
1199
1200 .sub 'foo'
1201     say 'foo'
1202 .end
1203 CODE
1204 bar
1205 2
1206 foo
1207 main
1208 OK
1209 OUT
1210
1211 pir_output_is( <<'CODE', <<'OUT', "make_namespace method");
1212 .sub 'main' :main
1213     $P0 = split ';', 'perl6;Foo;Bar'
1214     $P1 = get_root_namespace
1215     $P2 = $P1.'make_namespace'($P0)
1216     $I0 = isa $P2, 'NameSpace'
1217     say $I0
1218     $P3 = get_root_namespace ['perl6';'Foo';'Bar']
1219     $I0 = isnull $P3
1220     say $I0
1221     $I0 = issame $P2, $P3
1222     say $I0
1223 .end
1224 CODE
1225 1
1226 0
1227 1
1228 OUT
1229
1230 pir_error_output_like( <<'CODE', <<'OUT', 'adding :anon sub to a namespace, TT #56' );
1231 .namespace ['Foo']
1232 .sub main :main
1233     .const 'Sub' $P0 = 'bar'
1234
1235     set_global 'ok', $P0
1236     $P1 = get_global 'ok'
1237     say $P1
1238     $S0 = ok()
1239     say $S0
1240     $S0 = nok()
1241     say $S0
1242 .end
1243
1244 .namespace []
1245 .sub 'nok' :anon :subid('bar')
1246     .return( 'ok 1' )
1247 .end
1248 CODE
1249 /
1250 ok 1
1251 Could not find sub nok/
1252 OUT
1253
1254
1255 pir_output_is( <<'CODE', <<'OUT', 'HLL_map on namespace', todo => 'TT #867');
1256 .HLL 'tcl'
1257
1258 .sub 'foo' :anon :init
1259   $P1 = get_class 'NameSpace'
1260   $P2 = subclass $P1, 'BSNS'
1261   $P0 = getinterp
1262   $P0.'hll_map'($P1, $P2)
1263 .end
1264
1265 .namespace ['a';'b';'c']
1266
1267 .sub 'hi'
1268   noop
1269 .end
1270
1271 .namespace []
1272
1273 .sub 'blah' :main
1274   $P1 = get_hll_namespace ['a';'b';'c']
1275   $S0 = typeof $P1
1276   print 'ok 1 - '
1277   say $S0
1278 .end
1279 CODE
1280 ok 1 - BSNS
1281 OUT
1282
1283 # Local Variables:
1284 #   mode: cperl
1285 #   cperl-indent-level: 4
1286 #   fill-column: 100
1287 # End:
1288 # vim: expandtab shiftwidth=4: