[svn:parrot] r40991 - trunk/t/pmc

whiteknight at svn.parrot.org whiteknight at svn.parrot.org
Sat Sep 5 12:45:14 UTC 2009


Author: whiteknight
Date: Sat Sep  5 12:45:10 2009
New Revision: 40991
URL: https://trac.parrot.org/parrot/changeset/40991

Log:
move the perl-based namespace.t to namespace-old.t

Added:
   trunk/t/pmc/namespace-old.t   (props changed)
      - copied unchanged from r40990, trunk/t/pmc/namespace.t
Deleted:
   trunk/t/pmc/namespace.t

Copied: trunk/t/pmc/namespace-old.t (from r40990, trunk/t/pmc/namespace.t)
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/t/pmc/namespace-old.t	Sat Sep  5 12:45:10 2009	(r40991, copy of r40990, trunk/t/pmc/namespace.t)
@@ -0,0 +1,1845 @@
+#! perl
+# Copyright (C) 2001-2009, Parrot Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use lib qw( . lib ../lib ../../lib );
+use Test::More;
+use Parrot::Test tests => 68;
+use Parrot::Config;
+
+=head1 NAME
+
+t/pmc/namespace.t - test the NameSpace PMC as described in PDD 21.
+
+=head1 SYNOPSIS
+
+    % prove t/pmc/namespace.t
+
+=head1 DESCRIPTION
+
+Test the NameSpace PMC as described in PDD21.
+
+=cut
+
+# L<PDD21/Namespace PMC API/>
+pir_output_is( <<'CODE', <<'OUT', 'new' );
+.sub 'test' :main
+    new $P0, ['NameSpace']
+    say "ok 1 - $P0 = new ['NameSpace']"
+.end
+CODE
+ok 1 - $P0 = new ['NameSpace']
+OUT
+
+# L<PDD21/Namespace PMC API/=head4 Untyped Interface>
+pir_output_is( <<'CODE', <<'OUT', 'NameSpace does "hash"' );
+.sub 'test' :main
+    new $P0, ['NameSpace']
+    $I0 = does $P0, 'hash'
+    if $I0 goto ok_1
+    print 'not '
+  ok_1:
+    say 'ok 1 - NameSpace does "hash"'
+.end
+CODE
+ok 1 - NameSpace does "hash"
+OUT
+
+# L<PDD21//>
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global bar" );
+.sub 'main' :main
+    $P0 = get_global "bar"
+    print "ok\n"
+    $P0()
+.end
+
+.sub 'bar'
+    print "bar\n"
+.end
+CODE
+ok
+bar
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "verify NameSpace type" );
+.sub 'main' :main
+    $P0 = get_global "Foo"
+    typeof $S0, $P0
+    print $S0
+    print "\n"
+.end
+
+.namespace ["Foo"]
+.sub 'bar'
+    noop
+.end
+CODE
+NameSpace
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::bar" );
+.sub 'main' :main
+    $P0 = get_global ["Foo"], "bar"
+    print "ok\n"
+    $P0()
+.end
+
+.namespace ["Foo"]
+.sub 'bar'
+    print "bar\n"
+.end
+CODE
+ok
+bar
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_namespace Foo::bar" );
+.sub 'main' :main
+    $P0 = get_global ["Foo"], "bar"
+    print "ok\n"
+    $P1 = $P0."get_namespace"()
+    print $P1
+    print "\n"
+.end
+
+.namespace ["Foo"]
+.sub 'bar'
+.end
+CODE
+ok
+Foo
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::bar ns" );
+.sub 'main' :main
+    $P1 = get_global ["Foo"], "bar"
+    print "ok\n"
+    $P1()
+.end
+
+.namespace ["Foo"]
+.sub 'bar'
+    print "bar\n"
+.end
+CODE
+ok
+bar
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::bar hash" );
+.sub 'main' :main
+    $P0 = get_global "Foo"
+    $P1 = $P0["bar"]
+    print "ok\n"
+    $P1()
+.end
+
+.namespace ["Foo"]
+.sub 'bar'
+    print "bar\n"
+.end
+CODE
+ok
+bar
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::baz" );
+.sub 'main' :main
+    $P2 = get_global ["Foo";"Bar"], "baz"
+    print "ok\n"
+    $P2()
+.end
+
+.namespace ["Foo" ; "Bar"]
+.sub 'baz'
+    print "baz\n"
+.end
+CODE
+ok
+baz
+OUTPUT
+
+pir_error_output_like( <<'CODE', <<'OUTPUT', "get_global Foo::bazz not found" );
+.sub 'main' :main
+    $P2 = get_global ["Foo"], "bazz"
+    $P2()
+    print "ok\n"
+.end
+CODE
+/Null PMC access in invoke\(\)/
+OUTPUT
+
+# [this used to behave differently from the previous case.]
+pir_error_output_like( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::bazz not found" );
+.sub 'main' :main
+    $P2 = get_global ["Foo";"Bar"], "bazz"
+    $P2()
+    print "ok\n"
+.end
+CODE
+/Null PMC access in invoke\(\)/
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::baz hash" );
+.sub 'main' :main
+    $P0 = get_global "Foo"
+    $P1 = $P0["Bar"]
+    $P2 = $P1["baz"]
+    print "ok\n"
+    $P2()
+.end
+
+.namespace ["Foo"; "Bar"]
+.sub 'baz'
+    print "baz\n"
+.end
+CODE
+ok
+baz
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::baz hash 2" );
+.sub 'main' :main
+    $P0 = get_global "Foo"
+    $P1 = $P0["Bar" ; "baz"]
+    print "ok\n"
+    $P1()
+.end
+
+.namespace ["Foo"; "Bar"]
+.sub 'baz'
+    print "baz\n"
+.end
+CODE
+ok
+baz
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::baz alias" );
+.sub 'main' :main
+    $P0 = get_global "Foo"
+    $P1 = $P0["Bar"]
+    set_global "TopBar", $P1
+    $P2 = get_global ["TopBar"], "baz"
+    print "ok\n"
+    $P2()
+.end
+
+.namespace ["Foo"; "Bar"]
+.sub 'baz'
+    print "baz\n"
+.end
+CODE
+ok
+baz
+OUTPUT
+
+pir_error_output_like( <<'CODE', <<'OUTPUT', "func() namespace resolution" );
+.sub 'main' :main
+    print "calling foo\n"
+    foo()
+    print "calling Foo::foo\n"
+    $P0 = get_global ["Foo"], "foo"
+    $P0()
+    print "calling baz\n"
+    baz()
+.end
+
+.sub 'foo'
+    print "  foo\n"
+    bar()
+.end
+
+.sub 'bar'
+    print "  bar\n"
+.end
+
+.sub 'fie'
+    print "  fie\n"
+.end
+
+.namespace ["Foo"]
+
+.sub 'foo'
+    print "  Foo::foo\n"
+    bar()
+    fie()
+.end
+
+.sub 'bar'
+    print "  Foo::bar\n"
+.end
+
+.sub 'baz'
+    print "  Foo::baz\n"
+.end
+CODE
+/calling foo
+  foo
+  bar
+calling Foo::foo
+  Foo::foo
+  Foo::bar
+  fie
+calling baz
+Could not find non-existent sub baz/
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'get namespace of :anon .sub' );
+.namespace ['lib']
+.sub main :main :anon
+    $P0 = get_namespace
+    $P0 = $P0.'get_name'()
+    $S0 = join "::", $P0
+    say $S0
+    end
+.end
+CODE
+parrot::lib
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get namespace in Foo::bar" );
+.sub 'main' :main
+    $P0 = get_global ["Foo"], "bar"
+    print "ok\n"
+    $P0()
+.end
+
+.namespace ["Foo"]
+.sub 'bar'
+    print "bar\n"
+    .include "interpinfo.pasm"
+    $P0 = interpinfo .INTERPINFO_CURRENT_SUB
+    $P1 = $P0."get_namespace"()
+    print $P1
+    print "\n"
+.end
+CODE
+ok
+bar
+Foo
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get namespace in Foo::Bar::baz" );
+.sub 'main' :main
+    $P0 = get_global "Foo"
+    $P1 = $P0["Bar"]
+    $P2 = $P1["baz"]
+    print "ok\n"
+    $P2()
+.end
+
+.namespace ["Foo" ; "Bar"]
+.sub 'baz'
+    print "baz\n"
+    .include "interpinfo.pasm"
+    .include "pmctypes.pasm"
+    $P0 = interpinfo .INTERPINFO_CURRENT_SUB
+    $P1 = $P0."get_namespace"()
+    $P2 = $P1.'get_name'()
+    $S0 = join '::', $P2
+    print $S0
+    print "\n"
+.end
+CODE
+ok
+baz
+parrot::Foo::Bar
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "segv in get_name" );
+.namespace ['pugs';'main']
+.sub 'main' :main
+    $P0 = find_name "&say"
+    $P0()
+.end
+.sub "&say"
+    say "ok"
+.end
+CODE
+ok
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUT', "latin1 namespace, global" );
+.namespace [ iso-8859-1:"François" ]
+
+.sub 'test'
+    print "latin1 namespaces are fun\n"
+.end
+
+.namespace []
+
+.sub 'main' :main
+    $P0 = get_global [iso-8859-1:"François"], 'test'
+    $P0()
+.end
+CODE
+latin1 namespaces are fun
+OUT
+
+pir_output_is( <<'CODE', <<'OUT', "unicode namespace, global" );
+.namespace [ unicode:"Fran\xe7ois" ]
+
+.sub 'test'
+    print "unicode namespaces are fun\n"
+.end
+
+.namespace []
+
+.sub 'main' :main
+    $P0 = get_global [unicode:"Fran\xe7ois"], 'test'
+    $P0()
+.end
+CODE
+unicode namespaces are fun
+OUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "verify root and parrot namespaces" );
+# name may change though
+.sub main :main
+    # root namespace
+    $P0 = get_root_namespace
+    typeof $S0, $P0
+    print $S0
+    print "\n"
+    print $P0
+    print "\n"
+    # parrot namespace
+    $P1 = $P0["parrot"]
+    print $P1
+    print "\n"
+    typeof $S0, $P1
+    print $S0
+    print "\n"
+.end
+CODE
+NameSpace
+
+parrot
+NameSpace
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "ns.name()" );
+.sub main :main
+    .include "interpinfo.pasm"
+    $P0 = get_root_namespace
+    $P1 = $P0["parrot"]
+    $P3 = new ['NameSpace']
+    $P1["Foo"] = $P3
+    $P2 = $P3.'get_name'()
+    $I2 = elements $P2
+    print $I2
+    print "\n"
+    $S0 = join '::', $P2
+    print $S0
+    print "\n"
+.end
+CODE
+2
+parrot::Foo
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_namespace_p_p, getnamespace_p_kc" );
+.sub main :main
+    .include "interpinfo.pasm"
+    $P3 = new ['NameSpace']
+    set_hll_global "Foo", $P3
+    # fetch w array
+    $P4 = new ['FixedStringArray']
+    $P4 = 1
+    $P4[0] = 'Foo'
+    $P0 = get_hll_namespace $P4
+    $P2 = $P0.'get_name'()
+    $I2 = elements $P2
+    print $I2
+    print "\n"
+    $S0 = join '::', $P2
+    print $S0
+    print "\n"
+    # fetch w key
+    $P2 = get_hll_namespace ["Foo"]
+    $P2 = $P2.'get_name'()
+    $I2 = elements $P2
+    print $I2
+    print "\n"
+    $S0 = join '::', $P2
+    print $S0
+    print "\n"
+.end
+CODE
+2
+parrot::Foo
+2
+parrot::Foo
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "Sub.get_namespace, get_namespace" );
+.sub 'main' :main
+    $P0 = get_global ["Foo"], "bar"
+    print "ok\n"
+    $P1 = $P0."get_namespace"()
+    $P2 = $P1.'get_name'()
+    $S0 = join '::', $P2
+    print $S0
+    print "\n"
+    $P0()
+.end
+
+.namespace ["Foo"]
+.sub 'bar'
+    $P1 = get_namespace
+    print $P1
+    print "\n"
+.end
+CODE
+ok
+parrot::Foo
+Foo
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "check parrot ns" );
+.sub 'main' :main
+    $P0 = get_global ["String"], "lower"
+    $S0 = $P0("OK\n")
+    print $S0
+.end
+CODE
+ok
+OUTPUT
+
+my $temp_a = "temp_a";
+my $temp_b = "temp_b";
+
+END {
+    unlink( "$temp_a.pir", "$temp_a.pbc", "$temp_b.pir", "$temp_b.pbc" );
+}
+
+open my $S, '>', "$temp_a.pir" or die "Can't write $temp_a.pir";
+print $S <<'EOF';
+.HLL "Foo"
+.namespace ["Foo_A"]
+.sub loada :load
+    $P0 = get_global ["Foo_A"], "A"
+    print "ok 1\n"
+    load_bytecode "temp_b.pbc"
+.end
+
+.sub A
+.end
+EOF
+close $S;
+
+open $S, '>', "$temp_b.pir" or die "Can't write $temp_b.pir";
+print $S <<'EOF';
+.namespace ["Foo_B"]
+.sub loadb :load
+    $P0 = get_global ["Foo_B"], "B"
+    print "ok 2\n"
+.end
+
+.sub B
+.end
+EOF
+
+close $S;
+
+system(".$PConfig{slash}parrot$PConfig{exe} -o $temp_a.pbc $temp_a.pir");
+system(".$PConfig{slash}parrot$PConfig{exe} -o $temp_b.pbc $temp_b.pir");
+
+pir_output_is( <<'CODE', <<'OUTPUT', "HLL and load_bytecode - #38888" );
+.sub main :main
+    load_bytecode "temp_a.pbc"
+    print "ok 3\n"
+.end
+CODE
+ok 1
+ok 2
+ok 3
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "HLL and vars" );
+# initial storage of _tcl global variable...
+
+.HLL '_Tcl'
+
+.sub huh
+  $P0 = new ['Integer']
+  $P0 = 3.14
+  set_global '$variable', $P0
+.end
+
+# start running HLL language
+.HLL 'Tcl'
+
+.sub foo :main
+  huh()
+  $P1 = get_root_namespace ['_tcl']
+  $P2 = $P1['$variable']
+  print $P2
+  print "\n"
+.end
+CODE
+3.14
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "HLL and namespace directives" );
+.HLL '_Tcl'
+.namespace ['Foo'; 'Bar']
+
+.HLL 'Tcl'
+
+.sub main :main
+  $P0 = get_namespace
+  $P1 = $P0.'get_name'()
+  $S0 = join "::", $P1
+  print $S0
+  print "\n"
+  end
+.end
+CODE
+tcl
+OUTPUT
+
+{
+    my $temp_a = "temp_a.pir";
+
+    END {
+        unlink($temp_a);
+    }
+
+    open $S, '>', $temp_a or die "Can't write $temp_a";
+    print $S <<'EOF';
+.HLL 'eek'
+
+.sub foo :load :anon
+  $P1 = new ['String']
+  $P1 = "3.14\n"
+  set_global '$whee', $P1
+.end
+
+.sub bark
+  $P0 = get_global '$whee'
+  print $P0
+.end
+EOF
+    close $S;
+
+    pir_output_is( <<'CODE', <<'OUTPUT', ":anon subs still get default namespace" );
+.HLL 'cromulent'
+
+.sub what
+   load_bytecode 'temp_a.pir'
+  .local pmc var
+   var = get_root_namespace
+   var = var['eek']
+   var = var['bark']
+
+    var()
+.end
+CODE
+3.14
+OUTPUT
+}
+
+SKIP:
+{
+    skip( "immediate test, doesn't with --run-pbc", 1 )
+        if ( exists $ENV{TEST_PROG_ARGS} and $ENV{TEST_PROG_ARGS} =~ m/--run-pbc/ );
+
+    pir_output_is( <<'CODE', <<'OUTPUT', "get_global in current" );
+.HLL 'bork'
+.namespace []
+
+.sub a :immediate
+  $P1 = new ['String']
+  $P1 = "ok\n"
+  set_global ['sub_namespace'], "eek", $P1
+.end
+
+.namespace [ 'sub_namespace' ]
+
+.sub whee :main
+ $P1 = get_global 'eek'
+ print $P1
+.end
+CODE
+ok
+OUTPUT
+}
+
+open $S, '>', "$temp_b.pir" or die "Can't write $temp_b.pir";
+print $S <<'EOF';
+.HLL 'B'
+.sub b_foo
+    print "b_foo\n"
+.end
+EOF
+close $S;
+
+pir_error_output_like( <<'CODE', <<'OUTPUT', 'export_to() with null destination throws exception' );
+.sub 'test' :main
+    .local pmc nsa, nsb, ar
+
+    ar = new ['ResizableStringArray']
+    push ar, 'foo'
+    nsa = new ['Null']
+    nsb = get_namespace ['B']
+    nsb.'export_to'(nsa, ar)
+.end
+
+.namespace ['B']
+.sub 'foo' :anon
+.end
+CODE
+/^destination namespace not specified\n/
+OUTPUT
+
+pir_error_output_like(
+    <<'CODE', <<'OUTPUT', 'export_to() with null exports default object set !!!UNSPECIFIED!!!' );
+.sub 'test' :main
+    .local pmc nsa, nsb, ar
+
+    ar = new ['Null']
+    nsa = get_namespace
+    nsb = get_namespace ['B']
+    nsb.'export_to'(nsa, ar)
+.end
+
+.namespace ['B']
+.sub 'foo'
+.end
+CODE
+/^exporting default object set not yet implemented\n/
+OUTPUT
+
+pir_error_output_like(
+    <<'CODE', <<'OUTPUT', 'export_to() with empty array exports default object set !!!UNSPECIFIED!!!' );
+.sub 'test' :main
+    .local pmc nsa, nsb, ar
+
+    ar = new ['ResizableStringArray']
+    nsa = get_namespace
+    nsb = get_namespace ['B']
+    nsb.'export_to'(nsa, ar)
+.end
+
+.namespace ['B']
+.sub 'foo'
+.end
+CODE
+/^exporting default object set not yet implemented\n/
+OUTPUT
+
+pir_error_output_like(
+    <<'CODE', <<'OUTPUT', 'export_to() with empty hash exports default object set !!!UNSPECIFIED!!!' );
+.sub 'test' :main
+    .local pmc nsa, nsb, ar
+
+    ar = new ['Hash']
+    nsa = get_namespace
+    nsb = get_namespace ['B']
+    nsb.'export_to'(nsa, ar)
+.end
+
+.namespace ['B']
+.sub 'foo'
+.end
+CODE
+/^exporting default object set not yet implemented\n/
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with array" );
+.HLL 'A'
+.sub main :main
+    a_foo()
+    load_bytecode "$temp_b.pir"
+    .local pmc nsr, nsa, nsb, ar
+    ar = new ['ResizableStringArray']
+    push ar, "b_foo"
+    nsr = get_root_namespace
+    nsa = nsr['a']
+    nsb = nsr['b']
+    nsb."export_to"(nsa, ar)
+    b_foo()
+.end
+
+.sub a_foo
+    print "a_foo\\n"
+.end
+CODE
+a_foo
+b_foo
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with hash (empty value)" );
+.HLL 'A'
+.sub main :main
+    a_foo()
+    load_bytecode "$temp_b.pir"
+    .local pmc nsr, nsa, nsb, ar
+    ar = new ['Hash']
+    ar["b_foo"] = ""
+    nsr = get_root_namespace
+    nsa = nsr['a']
+    nsb = nsr['b']
+    nsb."export_to"(nsa, ar)
+    b_foo()
+.end
+
+.sub a_foo
+    print "a_foo\\n"
+.end
+CODE
+a_foo
+b_foo
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with hash (null value)" );
+.HLL 'A'
+.sub main :main
+    a_foo()
+    load_bytecode "$temp_b.pir"
+    .local pmc nsr, nsa, nsb, ar, nul
+    nul = new ['Null']
+    ar  = new ['Hash']
+    ar["b_foo"] = nul
+    nsr = get_root_namespace
+    nsa = nsr['a']
+    nsb = nsr['b']
+    nsb."export_to"(nsa, ar)
+    b_foo()
+.end
+
+.sub a_foo
+    print "a_foo\\n"
+.end
+CODE
+a_foo
+b_foo
+OUTPUT
+
+pir_error_output_like( <<"CODE", <<'OUTPUT', "export_to -- success with hash (and value)" );
+.HLL 'A'
+.sub main :main
+    a_foo()
+    load_bytecode "$temp_b.pir"
+    .local pmc nsr, nsa, nsb, ar
+    ar = new ['Hash']
+    ar["b_foo"] = "c_foo"
+    nsr = get_root_namespace
+    nsa = nsr['a']
+    nsb = nsr['b']
+    nsb."export_to"(nsa, ar)
+    c_foo()
+    b_foo()
+.end
+
+.sub a_foo
+    print "a_foo\\n"
+.end
+CODE
+/^a_foo
+b_foo
+Could not find non-existent sub b_foo/
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_parent" );
+.sub main :main
+    .local pmc ns
+    ns = get_hll_namespace ['Foo']
+    ns = ns.'get_parent'()
+    print ns
+    print "\n"
+.end
+.namespace ['Foo']
+.sub dummy
+.end
+CODE
+parrot
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global [''], \"print_ok\"" );
+.namespace ['']
+
+.sub print_ok
+  print "ok\n"
+  .return()
+.end
+
+.namespace ['foo']
+
+.sub main :main
+  $P0 = get_hll_global [''], 'print_ok'
+  $P0()
+  end
+.end
+CODE
+ok
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global with array ('')" );
+.namespace ['']
+
+.sub print_ok
+  print "ok\n"
+  .return()
+.end
+
+.namespace ['foo']
+
+.sub main :main
+  $P0 = new ['ResizableStringArray']
+  $P0[0] = ''
+  $P0 = get_hll_global $P0, 'print_ok'
+  $P0()
+  end
+.end
+CODE
+ok
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global with empty array" );
+.namespace []
+
+.sub print_ok
+  print "ok\n"
+  .return()
+.end
+
+.namespace ['foo']
+
+.sub main :main
+  $P0 = new ['ResizablePMCArray']
+  $P0 = 0
+  $P0 = get_hll_global $P0, 'print_ok'
+  $P0()
+  end
+.end
+CODE
+ok
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "Namespace.get_global() with array ('')" );
+.namespace ['']
+
+.sub print_ok
+  print "ok\n"
+  .return()
+.end
+
+.namespace ['foo']
+
+.sub main :main
+  $P1 = new ['ResizableStringArray']
+  $P1[0] = ''
+  $P1 = get_hll_global $P1, 'print_ok'
+  $P1()
+  end
+.end
+CODE
+ok
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "Namespace introspection" );
+.sub main :main
+    .local pmc f
+    f = get_hll_global ['Foo'], 'dummy'
+    f()
+.end
+.namespace ['Foo']
+.sub dummy
+    .local pmc interp, ns_caller
+    interp = getinterp
+    ns_caller = interp['namespace'; 1]
+    print ns_caller
+    print "\n"
+.end
+CODE
+parrot
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "Nested namespace introspection" );
+.sub main :main
+    .local string no_symbol
+
+    .local pmc foo_ns
+    foo_ns = get_hll_namespace [ 'Foo' ]
+    $S0    = foo_ns
+    print "Found namespace: "
+    print $S0
+    print "\n"
+
+    .local pmc bar_ns
+    bar_ns = foo_ns.'find_namespace'( 'Bar' )
+    $S0    = bar_ns
+    print "Found nested namespace: "
+    print $S0
+    print "\n"
+
+    .local pmc baz_ns
+    baz_ns    = bar_ns.'find_namespace'( 'Baz' )
+    no_symbol = 'Baz'
+
+    .local int is_defined
+    is_defined = defined baz_ns
+    if is_defined goto oops
+    goto find_symbols
+
+  oops:
+    print "Found non-null '"
+    print no_symbol
+    print "'\n"
+    .return()
+
+  find_symbols:
+    .local pmc a_sub
+    a_sub = bar_ns.'find_sub'( 'a_sub' )
+    $S0   = a_sub
+    a_sub()
+    print "Found sub: "
+    print $S0
+    print "\n"
+
+    .local pmc some_sub
+    some_sub  = bar_ns.'find_sub'( 'some_sub' )
+    no_symbol = 'some_sub'
+
+    is_defined = defined some_sub
+    if is_defined goto oops
+
+    .local pmc a_var
+    a_var    = bar_ns.'find_var'( 'a_var' )
+    print "Found var: "
+    print a_var
+    print "\n"
+
+    .local pmc some_var
+    some_var    = bar_ns.'find_var'( 'some_var' )
+    no_symbol = 'some_var'
+
+    is_defined = defined some_var
+    if is_defined goto oops
+
+.end
+
+.namespace ['Foo']
+
+.sub some_sub
+.end
+
+.namespace [ 'Foo'; 'Bar' ]
+
+.sub a_sub
+    .local pmc some_var
+    some_var = new ['String']
+    some_var = 'a string PMC'
+    set_hll_global [ 'Foo'; 'Bar' ], 'a_var', some_var
+.end
+CODE
+Found namespace: Foo
+Found nested namespace: Bar
+Found sub: a_sub
+Found var: a string PMC
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace' );
+.sub main :main
+    .local pmc root_ns
+    root_ns = get_root_namespace
+    .local int is_defined
+    is_defined = defined root_ns
+    unless is_defined goto NO_NAMESPACE_FOUND
+        print "Found root namespace.\n"
+    NO_NAMESPACE_FOUND:
+.end
+CODE
+Found root namespace.
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'root namespace is not a class' );
+.sub main :main
+    .local pmc root_ns
+    root_ns = get_root_namespace
+    .local pmc root_class
+    root_class = get_class root_ns
+    .local int is_class
+    is_class = defined root_class
+    say is_class
+.end
+CODE
+0
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace "Foo"' );
+.sub main :main
+    .local pmc foo_ns
+    foo_ns = get_root_namespace [ "foo" ]
+    .local int is_defined
+    is_defined = defined foo_ns
+    unless is_defined goto NO_NAMESPACE_FOUND
+        print "Found root namespace 'foo'.\n"
+    NO_NAMESPACE_FOUND:
+.end
+.HLL 'Foo'
+.sub dummy
+.end
+CODE
+Found root namespace 'foo'.
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace "Foo", not there' );
+.sub main :main
+    .local pmc foo_ns
+    foo_ns = get_root_namespace [ "Foo" ]
+    .local int is_defined
+    is_defined = defined foo_ns
+    if is_defined goto NAMESPACE_FOUND
+        print "Didn't find root namespace 'Foo'.\n"
+    NAMESPACE_FOUND:
+.end
+
+.namespace [ "NotFoo" ]
+CODE
+Didn't find root namespace 'Foo'.
+OUTPUT
+
+my $create_nested_key = <<'CREATE_NESTED_KEY';
+.sub create_nested_key
+    .param string name
+    .param pmc other_names :slurpy
+
+    .local pmc key
+    key = new ['Key']
+    key = name
+
+    .local int elem
+    elem = other_names
+
+    if elem goto nested
+    .return( key )
+
+  nested:
+    .local pmc tail
+    tail = create_nested_key(other_names :flat)
+    push key, tail
+
+    .return( key )
+.end
+CREATE_NESTED_KEY
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'get_name()' );
+$create_nested_key
+
+.sub main :main
+    .local pmc key
+    key = create_nested_key( 'SingleName' )
+    print_namespace( key )
+
+    key = create_nested_key( 'Nested', 'Name', 'Space' )
+    print_namespace( key )
+
+    key = get_namespace
+
+    .local pmc ns
+    ns = key.'get_name'()
+
+    .local string ns_name
+    ns_name = join ';', ns
+    print ns_name
+    print "\\n"
+.end
+
+.sub 'print_namespace'
+    .param pmc key
+
+    .local pmc get_ns
+    get_ns = get_global key, 'get_namespace'
+
+    .local pmc ns
+    ns = get_ns()
+
+    .local pmc name_array
+    name_array = ns.'get_name'()
+
+    .local string name
+    name = join ';', name_array
+
+    print name
+    print "\\n"
+.end
+
+.sub get_namespace
+    .local pmc ns
+    ns = get_namespace
+    .return( ns )
+.end
+
+.namespace [ 'SingleName' ]
+
+.sub get_namespace
+    .local pmc ns
+    ns = get_namespace
+    .return( ns )
+.end
+
+.namespace [ 'Nested'; 'Name'; 'Space' ]
+
+.sub get_namespace
+    .local pmc ns
+    ns = get_namespace
+    .return( ns )
+.end
+
+CODE
+parrot;SingleName
+parrot;Nested;Name;Space
+parrot
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'add_namespace()' );
+$create_nested_key
+
+.sub main :main
+    .local pmc root_ns
+    root_ns = get_namespace
+
+    .local pmc child_ns
+    child_ns = new ['NameSpace']
+    root_ns.'add_namespace'( 'Nested', child_ns )
+
+    .local pmc grandchild_ns
+    grandchild_ns = new ['NameSpace']
+    child_ns.'add_namespace'( 'Grandkid', grandchild_ns )
+
+    .local pmc great_grandchild_ns
+    great_grandchild_ns = new ['NameSpace']
+    grandchild_ns.'add_namespace'( 'Greatgrandkid', great_grandchild_ns )
+
+    .local pmc parent
+    parent = great_grandchild_ns.'get_parent'()
+    print_ns_name( parent )
+
+    parent = parent.'get_parent'()
+    print_ns_name( parent )
+
+    parent = parent.'get_parent'()
+    print_ns_name( parent )
+.end
+
+.sub print_ns_name
+    .param pmc namespace
+
+    .local pmc ns
+    ns = namespace.'get_name'()
+
+    .local string ns_name
+    ns_name = join ';', ns
+    print ns_name
+    print "\\n"
+.end
+CODE
+parrot;Nested;Grandkid
+parrot;Nested
+parrot
+OUTPUT
+
+pir_output_like( <<'CODE', <<'OUTPUT', 'add_namespace() with error' );
+.sub main :main
+    .local pmc ns_child
+    ns_child = subclass 'NameSpace', 'NSChild'
+
+    .local pmc child
+    child = new ['NSChild']
+
+    .local pmc root_ns
+    root_ns = get_namespace
+
+    root_ns.'add_namespace'( 'Really nested', child )
+
+    .local pmc not_a_ns
+    not_a_ns = new ['Integer']
+
+    push_eh _invalid_ns
+    root_ns.'add_namespace'( 'Nested', not_a_ns )
+    end
+
+_invalid_ns:
+    .local pmc exception
+    .local string message
+    .get_results( exception )
+
+    message = exception
+    print message
+    print "\n"
+.end
+CODE
+/Invalid type \d+ in add_namespace\(\)/
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'add_sub()' );
+$create_nested_key
+
+.sub 'main' :main
+    .local pmc report_ns
+    report_ns = get_global 'report_namespace'
+
+    .local pmc key
+    key = create_nested_key( 'Parent' )
+
+    .local pmc parent_ns
+    parent_ns = get_namespace key
+    parent_ns.'add_sub'( 'report_ns', report_ns )
+
+    key = create_nested_key( 'Parent', 'Child' )
+
+    .local pmc child_ns
+    child_ns = get_namespace key
+    child_ns.'add_sub'( 'report_ns', report_ns )
+
+    .local pmc report_namespace
+    report_namespace = get_global [ 'Parent' ], 'report_ns'
+    report_namespace()
+
+    report_namespace = get_global [ 'Parent'; 'Child' ], 'report_ns'
+    report_namespace()
+.end
+
+.sub 'report_namespace'
+    .local pmc namespace
+    namespace = get_namespace
+
+    .local pmc ns
+    ns = namespace.'get_name'()
+
+    .local string ns_name
+    ns_name = join ';', ns
+    print ns_name
+    print "\\n"
+.end
+
+.namespace [ 'Parent' ]
+
+.sub dummy
+.end
+
+.namespace [ 'Parent'; 'Child' ]
+
+.sub dummy
+.end
+CODE
+parrot
+parrot
+OUTPUT
+
+pir_output_like( <<'CODE', <<'OUTPUT', 'add_sub() with error' );
+.sub main :main
+    .local pmc s_child
+    s_child = subclass 'Sub', 'SubChild'
+
+    .local pmc child
+    child = new ['SubChild']
+
+    .local pmc root_ns
+    root_ns = get_namespace
+
+    root_ns.'add_sub'( 'child', child )
+    print "Added sub child\n"
+
+    child = new ['Coroutine']
+    root_ns.'add_sub'( 'coroutine', child )
+    print "Added coroutine\n"
+
+    child = new ['Eval']
+    root_ns.'add_sub'( 'eval', child )
+    print "Added eval\n"
+
+    .local pmc not_a_sub
+    not_a_sub = new ['Integer']
+
+    push_eh _invalid_sub
+    root_ns.'add_sub'( 'Nested', not_a_sub )
+    end
+
+_invalid_sub:
+    .local pmc exception
+    .local string message
+    .get_results( exception )
+
+    message = exception
+    print message
+    print "\n"
+.end
+CODE
+/Added sub child
+Added coroutine
+Added eval
+Invalid type \d+ in add_sub\(\)/
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'add_var()' );
+$create_nested_key
+
+.sub 'main' :main
+    .local pmc foo
+    foo = new ['String']
+    foo = 'Foo'
+
+    .local pmc bar
+    bar = new ['String']
+    bar = 'Bar'
+
+    .local pmc key
+    key = create_nested_key( 'Parent' )
+
+    .local pmc parent_ns
+    parent_ns = get_namespace key
+    parent_ns.'add_var'( 'foo', foo )
+
+    key = create_nested_key( 'Parent', 'Child' )
+
+    .local pmc child_ns
+    child_ns = get_namespace key
+    child_ns.'add_var'( 'bar', bar )
+
+    .local pmc my_var
+    my_var = get_global [ 'Parent' ], 'foo'
+    print "Foo: "
+    print my_var
+    print "\\n"
+
+    my_var = get_global [ 'Parent'; 'Child' ], 'bar'
+    print "Bar: "
+    print my_var
+    print "\\n"
+.end
+
+.namespace [ 'Parent' ]
+
+.sub dummy
+.end
+
+.namespace [ 'Parent'; 'Child' ]
+
+.sub dummy
+.end
+CODE
+Foo: Foo
+Bar: Bar
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'del_namespace()' );
+$create_nested_key
+
+.sub 'main' :main
+    .local pmc root_ns
+    root_ns = get_namespace
+
+    .local pmc key
+    key      = create_nested_key( 'Parent' )
+
+    .local pmc child_ns
+    child_ns = root_ns.'find_namespace'( key )
+
+    key      = create_nested_key( 'Child' )
+
+    .local pmc grandchild_ns
+    grandchild_ns = child_ns.'find_namespace'( key )
+
+    child_ns.'del_namespace'( 'Child' )
+
+    key      = create_nested_key( 'Child' )
+
+    grandchild_ns = child_ns.'find_namespace'( key )
+    if_null grandchild_ns, CHECK_SIBLING
+    print "Grandchild still exists\\n"
+
+  CHECK_SIBLING:
+    key      = create_nested_key( 'Sibling' )
+    grandchild_ns = child_ns.'find_namespace'( key )
+    if_null grandchild_ns, DELETE_PARENT
+    print "Sibling not deleted\\n"
+
+  DELETE_PARENT:
+    key      = create_nested_key( 'Parent' )
+    root_ns.'del_namespace'( 'Parent' )
+    child_ns = root_ns.'find_namespace'( key )
+    if_null child_ns, CHECK_UNCLE
+    print "Child still exists\\n"
+
+  CHECK_UNCLE:
+    key      = create_nested_key( 'FunUncle' )
+    grandchild_ns = root_ns.'find_namespace'( key )
+    if_null grandchild_ns, DELETE_PARENT
+    print "Fun uncle stuck around\\n"
+
+  ALL_DONE:
+.end
+
+.namespace [ 'FunUncle' ]
+
+.sub dummy
+.end
+
+.namespace [ 'Parent' ]
+
+.sub dummy
+.end
+
+.namespace [ 'Parent'; 'Child' ]
+
+.sub dummy
+.end
+
+.namespace [ 'Parent'; 'Sibling' ]
+
+.sub dummy
+.end
+CODE
+Sibling not deleted
+Fun uncle stuck around
+OUTPUT
+
+pir_output_like( <<'CODE', <<'OUTPUT', 'del_namespace() with error' );
+.sub dummy
+.end
+
+.sub main :main
+    .local pmc not_a_ns
+    not_a_ns = new ['Array']
+
+    set_global 'Not_A_NS', not_a_ns
+
+    .local pmc root_ns
+    root_ns = get_namespace
+    delete_namespace( root_ns, 'dummy' )
+    delete_namespace( root_ns, 'Not_A_NS' )
+.end
+
+.sub delete_namespace
+    .param pmc    root_ns
+    .param string name
+    push_eh _invalid_ns
+    root_ns.'del_namespace'( name )
+
+_invalid_ns:
+    .local pmc exception
+    .local string message
+    .get_results( exception )
+
+    message = exception
+    print message
+    print "\n"
+    .return()
+.end
+CODE
+/Invalid type \d+ for 'dummy' in del_namespace\(\)
+Invalid type \d+ for 'Not_A_NS' in del_namespace\(\)/
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'del_sub()' );
+.sub 'main' :main
+    .local pmc root_ns
+    root_ns = get_namespace
+
+    .local pmc parent_ns
+    parent_ns = root_ns.'find_namespace'( 'Parent' )
+    parent_ns.'del_sub'( 'dummy' )
+
+    .local pmc my_sub
+    my_sub = get_global [ 'Parent' ], 'dummy'
+    if_null my_sub, PARENT_NO_DUMMY
+    print "Parent did not delete dummy\\n"
+
+  PARENT_NO_DUMMY:
+    my_sub = get_global [ 'Parent' ], 'no_dummy'
+    my_sub()
+
+    .local pmc child_ns
+    child_ns = parent_ns.'find_namespace'( 'Child' )
+    child_ns.'del_sub'( 'dummy' )
+
+    my_sub = get_global [ 'Parent'; 'Child' ], 'dummy'
+    if_null my_sub, CHILD_NO_DUMMY
+    print "Child did not delete dummy\\n"
+    my_sub()
+
+  CHILD_NO_DUMMY:
+    my_sub = get_global [ 'Parent'; 'Child' ], 'no_dummy'
+    my_sub()
+.end
+
+.namespace [ 'Parent' ]
+
+.sub dummy
+.end
+
+.sub no_dummy
+    print "Parent is no dummy\\n"
+.end
+
+.namespace [ 'Parent'; 'Child' ]
+
+.sub dummy
+    print "Dummy sub!\\n"
+.end
+
+.sub no_dummy
+    print "Child is no dummy\\n"
+.end
+
+CODE
+Parent is no dummy
+Child is no dummy
+OUTPUT
+
+pir_output_like( <<'CODE', <<'OUTPUT', 'del_sub() with error' );
+.sub main :main
+    .local pmc not_a_ns
+    not_a_ns = new ['Array']
+
+    set_global 'Not_A_Sub', not_a_ns
+
+    .local pmc root_ns
+    root_ns = get_namespace
+
+    push_eh _invalid_sub
+    root_ns.'del_sub'( 'Not_A_Sub' )
+
+_invalid_sub:
+    .local pmc exception
+    .local string message
+    .get_results( exception )
+
+    message = exception
+    print message
+    print "\n"
+    .return()
+.end
+CODE
+/Invalid type \d+ for 'Not_A_Sub' in del_sub\(\)/
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'del_var()' );
+.sub 'main' :main
+    .local pmc foo
+    foo = new ['String']
+    foo = 'Foo'
+
+    .local pmc bar
+    bar = new ['String']
+    bar = 'Bar'
+
+    set_global [ 'Parent' ],          'Foo', foo
+    set_global [ 'Parent'; 'Child' ], 'Bar', bar
+
+    .local pmc root_ns
+    root_ns = get_namespace
+
+    .local pmc parent_ns
+    parent_ns = root_ns.'find_namespace'( 'Parent' )
+    parent_ns.'del_var'( 'Foo' )
+
+    .local pmc child_ns
+    child_ns = parent_ns.'find_namespace'( 'Child' )
+    child_ns.'del_var'( 'Bar' )
+
+    .local pmc my_var
+    my_var = get_global [ 'Parent' ], 'Foo'
+    if_null my_var, TEST_CHILD_VAR
+    print "Parent Foo exists: "
+    print my_var
+    print "\\n"
+
+  TEST_CHILD_VAR:
+    my_var = get_global [ 'Parent'; 'Child' ], 'Bar'
+    if_null my_var, ALL_DONE
+    print "Child Bar exists: "
+    print my_var
+    print "\\n"
+
+  ALL_DONE:
+.end
+
+.namespace [ 'Parent' ]
+
+.sub dummy
+.end
+
+.namespace [ 'Parent'; 'Child' ]
+
+CODE
+OUTPUT
+
+pir_error_output_like( <<'CODE', <<'OUTPUT', 'overriding find_method()' );
+.sub 'main' :main
+    $P0 = newclass 'Override'
+    $P1 = new ['Override']
+    $P2 = find_method $P1, 'foo'
+.end
+
+.namespace [ 'Override' ]
+
+.sub 'find_method' :vtable
+    .param string method
+    say "Finding method"
+.end
+CODE
+/Finding method/
+OUTPUT
+
+pir_output_is( <<'CODE', <<OUT, "iterate through a NameSpace PMC, RT #39978" );
+.sub main :main
+     $P0 = new ['String']
+     $P0 = "Ook...BANG!\n"
+     set_root_global [ "DUMMY"; "X"; "Y" ], "Explosion", $P0
+
+     $P1 = new ['Integer']
+     $P1 = 0
+     set_root_global [ "DUMMY"; "X"; "Y" ], "T0", $P0
+
+     .local pmc dummy_x_y_ns, it, res
+     dummy_x_y_ns = get_root_namespace [ "DUMMY"; "X"; "Y" ]
+     it   = iter dummy_x_y_ns
+     res  = new ['ResizablePMCArray']
+loop:
+     unless it goto loop_end
+     $S0 = shift it
+     push res, $S0
+     goto loop
+loop_end:
+
+     res.'sort'()
+     $S0 = join ' ', res
+     say $S0
+
+.end
+CODE
+Explosion T0
+OUT
+
+pir_error_output_like( <<'CODE', <<OUT, "NameSpace with no class, RT #55620" );
+.sub 'main' :main
+    $P1 = new ['NameSpace']
+    set_args '(0)', $P1
+    tailcallmethod $P1, 'bob'
+.end
+CODE
+/Null PMC access in get_string()/
+OUT
+
+pir_output_is( <<'CODE', <<OUT, "iterate through a NameSpace PMC" );
+.namespace [ 'bar' ]
+
+.sub 'main' :main
+    .local pmc res
+    res = new ['ResizablePMCArray']
+
+    $P0 = get_namespace
+    say $P0
+    $I0 = elements $P0
+    say $I0
+    $P1 = iter $P0
+  L1:
+    unless $P1 goto L2
+    $P2 = shift $P1
+    $S0 = $P2
+    push res, $S0
+    goto L1
+  L2:
+    res.'sort'()
+    $S0 = join "\n", res
+    say $S0
+    say 'OK'
+.end
+
+.sub 'foo'
+    say 'foo'
+.end
+CODE
+bar
+2
+foo
+main
+OK
+OUT
+
+pir_output_is( <<'CODE', <<'OUT', "make_namespace method");
+.sub 'main' :main
+    $P0 = split ';', 'perl6;Foo;Bar'
+    $P1 = get_root_namespace
+    $P2 = $P1.'make_namespace'($P0)
+    $I0 = isa $P2, 'NameSpace'
+    say $I0
+    $P3 = get_root_namespace ['perl6';'Foo';'Bar']
+    $I0 = isnull $P3
+    say $I0
+    $I0 = issame $P2, $P3
+    say $I0
+.end
+CODE
+1
+0
+1
+OUT
+
+pir_error_output_like( <<'CODE', <<'OUT', 'adding :anon sub to a namespace, TT #56' );
+.namespace ['Foo']
+.sub main :main
+    .const 'Sub' $P0 = 'bar'
+
+    set_global 'ok', $P0
+    $P1 = get_global 'ok'
+    say $P1
+    $S0 = ok()
+    say $S0
+    $S0 = nok()
+    say $S0
+.end
+
+.namespace []
+.sub 'nok' :anon :subid('bar')
+    .return( 'ok 1' )
+.end
+CODE
+/
+ok 1
+Could not find non-existent sub nok/
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', 'HLL_map on namespace', todo => 'TT #867');
+.HLL 'tcl'
+
+.sub 'foo' :anon :init
+  $P1 = get_class 'NameSpace'
+  $P2 = subclass $P1, 'BSNS'
+  $P0 = getinterp
+  $P0.'hll_map'($P1, $P2)
+.end
+
+.namespace ['a';'b';'c']
+
+.sub 'hi'
+  noop
+.end
+
+.namespace []
+
+.sub 'blah' :main
+  $P1 = get_hll_namespace ['a';'b';'c']
+  $S0 = typeof $P1
+  print 'ok 1 - '
+  say $S0
+.end
+CODE
+ok 1 - BSNS
+OUT
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:

Deleted: trunk/t/pmc/namespace.t
==============================================================================
--- trunk/t/pmc/namespace.t	Sat Sep  5 12:45:10 2009	(r40990)
+++ /dev/null	00:00:00 1970	(deleted)
@@ -1,1845 +0,0 @@
-#! perl
-# Copyright (C) 2001-2009, Parrot Foundation.
-# $Id$
-
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-use Test::More;
-use Parrot::Test tests => 68;
-use Parrot::Config;
-
-=head1 NAME
-
-t/pmc/namespace.t - test the NameSpace PMC as described in PDD 21.
-
-=head1 SYNOPSIS
-
-    % prove t/pmc/namespace.t
-
-=head1 DESCRIPTION
-
-Test the NameSpace PMC as described in PDD21.
-
-=cut
-
-# L<PDD21/Namespace PMC API/>
-pir_output_is( <<'CODE', <<'OUT', 'new' );
-.sub 'test' :main
-    new $P0, ['NameSpace']
-    say "ok 1 - $P0 = new ['NameSpace']"
-.end
-CODE
-ok 1 - $P0 = new ['NameSpace']
-OUT
-
-# L<PDD21/Namespace PMC API/=head4 Untyped Interface>
-pir_output_is( <<'CODE', <<'OUT', 'NameSpace does "hash"' );
-.sub 'test' :main
-    new $P0, ['NameSpace']
-    $I0 = does $P0, 'hash'
-    if $I0 goto ok_1
-    print 'not '
-  ok_1:
-    say 'ok 1 - NameSpace does "hash"'
-.end
-CODE
-ok 1 - NameSpace does "hash"
-OUT
-
-# L<PDD21//>
-pir_output_is( <<'CODE', <<'OUTPUT', "get_global bar" );
-.sub 'main' :main
-    $P0 = get_global "bar"
-    print "ok\n"
-    $P0()
-.end
-
-.sub 'bar'
-    print "bar\n"
-.end
-CODE
-ok
-bar
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "verify NameSpace type" );
-.sub 'main' :main
-    $P0 = get_global "Foo"
-    typeof $S0, $P0
-    print $S0
-    print "\n"
-.end
-
-.namespace ["Foo"]
-.sub 'bar'
-    noop
-.end
-CODE
-NameSpace
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::bar" );
-.sub 'main' :main
-    $P0 = get_global ["Foo"], "bar"
-    print "ok\n"
-    $P0()
-.end
-
-.namespace ["Foo"]
-.sub 'bar'
-    print "bar\n"
-.end
-CODE
-ok
-bar
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_namespace Foo::bar" );
-.sub 'main' :main
-    $P0 = get_global ["Foo"], "bar"
-    print "ok\n"
-    $P1 = $P0."get_namespace"()
-    print $P1
-    print "\n"
-.end
-
-.namespace ["Foo"]
-.sub 'bar'
-.end
-CODE
-ok
-Foo
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::bar ns" );
-.sub 'main' :main
-    $P1 = get_global ["Foo"], "bar"
-    print "ok\n"
-    $P1()
-.end
-
-.namespace ["Foo"]
-.sub 'bar'
-    print "bar\n"
-.end
-CODE
-ok
-bar
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::bar hash" );
-.sub 'main' :main
-    $P0 = get_global "Foo"
-    $P1 = $P0["bar"]
-    print "ok\n"
-    $P1()
-.end
-
-.namespace ["Foo"]
-.sub 'bar'
-    print "bar\n"
-.end
-CODE
-ok
-bar
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::baz" );
-.sub 'main' :main
-    $P2 = get_global ["Foo";"Bar"], "baz"
-    print "ok\n"
-    $P2()
-.end
-
-.namespace ["Foo" ; "Bar"]
-.sub 'baz'
-    print "baz\n"
-.end
-CODE
-ok
-baz
-OUTPUT
-
-pir_error_output_like( <<'CODE', <<'OUTPUT', "get_global Foo::bazz not found" );
-.sub 'main' :main
-    $P2 = get_global ["Foo"], "bazz"
-    $P2()
-    print "ok\n"
-.end
-CODE
-/Null PMC access in invoke\(\)/
-OUTPUT
-
-# [this used to behave differently from the previous case.]
-pir_error_output_like( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::bazz not found" );
-.sub 'main' :main
-    $P2 = get_global ["Foo";"Bar"], "bazz"
-    $P2()
-    print "ok\n"
-.end
-CODE
-/Null PMC access in invoke\(\)/
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::baz hash" );
-.sub 'main' :main
-    $P0 = get_global "Foo"
-    $P1 = $P0["Bar"]
-    $P2 = $P1["baz"]
-    print "ok\n"
-    $P2()
-.end
-
-.namespace ["Foo"; "Bar"]
-.sub 'baz'
-    print "baz\n"
-.end
-CODE
-ok
-baz
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::baz hash 2" );
-.sub 'main' :main
-    $P0 = get_global "Foo"
-    $P1 = $P0["Bar" ; "baz"]
-    print "ok\n"
-    $P1()
-.end
-
-.namespace ["Foo"; "Bar"]
-.sub 'baz'
-    print "baz\n"
-.end
-CODE
-ok
-baz
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_global Foo::Bar::baz alias" );
-.sub 'main' :main
-    $P0 = get_global "Foo"
-    $P1 = $P0["Bar"]
-    set_global "TopBar", $P1
-    $P2 = get_global ["TopBar"], "baz"
-    print "ok\n"
-    $P2()
-.end
-
-.namespace ["Foo"; "Bar"]
-.sub 'baz'
-    print "baz\n"
-.end
-CODE
-ok
-baz
-OUTPUT
-
-pir_error_output_like( <<'CODE', <<'OUTPUT', "func() namespace resolution" );
-.sub 'main' :main
-    print "calling foo\n"
-    foo()
-    print "calling Foo::foo\n"
-    $P0 = get_global ["Foo"], "foo"
-    $P0()
-    print "calling baz\n"
-    baz()
-.end
-
-.sub 'foo'
-    print "  foo\n"
-    bar()
-.end
-
-.sub 'bar'
-    print "  bar\n"
-.end
-
-.sub 'fie'
-    print "  fie\n"
-.end
-
-.namespace ["Foo"]
-
-.sub 'foo'
-    print "  Foo::foo\n"
-    bar()
-    fie()
-.end
-
-.sub 'bar'
-    print "  Foo::bar\n"
-.end
-
-.sub 'baz'
-    print "  Foo::baz\n"
-.end
-CODE
-/calling foo
-  foo
-  bar
-calling Foo::foo
-  Foo::foo
-  Foo::bar
-  fie
-calling baz
-Could not find non-existent sub baz/
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', 'get namespace of :anon .sub' );
-.namespace ['lib']
-.sub main :main :anon
-    $P0 = get_namespace
-    $P0 = $P0.'get_name'()
-    $S0 = join "::", $P0
-    say $S0
-    end
-.end
-CODE
-parrot::lib
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get namespace in Foo::bar" );
-.sub 'main' :main
-    $P0 = get_global ["Foo"], "bar"
-    print "ok\n"
-    $P0()
-.end
-
-.namespace ["Foo"]
-.sub 'bar'
-    print "bar\n"
-    .include "interpinfo.pasm"
-    $P0 = interpinfo .INTERPINFO_CURRENT_SUB
-    $P1 = $P0."get_namespace"()
-    print $P1
-    print "\n"
-.end
-CODE
-ok
-bar
-Foo
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get namespace in Foo::Bar::baz" );
-.sub 'main' :main
-    $P0 = get_global "Foo"
-    $P1 = $P0["Bar"]
-    $P2 = $P1["baz"]
-    print "ok\n"
-    $P2()
-.end
-
-.namespace ["Foo" ; "Bar"]
-.sub 'baz'
-    print "baz\n"
-    .include "interpinfo.pasm"
-    .include "pmctypes.pasm"
-    $P0 = interpinfo .INTERPINFO_CURRENT_SUB
-    $P1 = $P0."get_namespace"()
-    $P2 = $P1.'get_name'()
-    $S0 = join '::', $P2
-    print $S0
-    print "\n"
-.end
-CODE
-ok
-baz
-parrot::Foo::Bar
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "segv in get_name" );
-.namespace ['pugs';'main']
-.sub 'main' :main
-    $P0 = find_name "&say"
-    $P0()
-.end
-.sub "&say"
-    say "ok"
-.end
-CODE
-ok
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUT', "latin1 namespace, global" );
-.namespace [ iso-8859-1:"François" ]
-
-.sub 'test'
-    print "latin1 namespaces are fun\n"
-.end
-
-.namespace []
-
-.sub 'main' :main
-    $P0 = get_global [iso-8859-1:"François"], 'test'
-    $P0()
-.end
-CODE
-latin1 namespaces are fun
-OUT
-
-pir_output_is( <<'CODE', <<'OUT', "unicode namespace, global" );
-.namespace [ unicode:"Fran\xe7ois" ]
-
-.sub 'test'
-    print "unicode namespaces are fun\n"
-.end
-
-.namespace []
-
-.sub 'main' :main
-    $P0 = get_global [unicode:"Fran\xe7ois"], 'test'
-    $P0()
-.end
-CODE
-unicode namespaces are fun
-OUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "verify root and parrot namespaces" );
-# name may change though
-.sub main :main
-    # root namespace
-    $P0 = get_root_namespace
-    typeof $S0, $P0
-    print $S0
-    print "\n"
-    print $P0
-    print "\n"
-    # parrot namespace
-    $P1 = $P0["parrot"]
-    print $P1
-    print "\n"
-    typeof $S0, $P1
-    print $S0
-    print "\n"
-.end
-CODE
-NameSpace
-
-parrot
-NameSpace
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "ns.name()" );
-.sub main :main
-    .include "interpinfo.pasm"
-    $P0 = get_root_namespace
-    $P1 = $P0["parrot"]
-    $P3 = new ['NameSpace']
-    $P1["Foo"] = $P3
-    $P2 = $P3.'get_name'()
-    $I2 = elements $P2
-    print $I2
-    print "\n"
-    $S0 = join '::', $P2
-    print $S0
-    print "\n"
-.end
-CODE
-2
-parrot::Foo
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_namespace_p_p, getnamespace_p_kc" );
-.sub main :main
-    .include "interpinfo.pasm"
-    $P3 = new ['NameSpace']
-    set_hll_global "Foo", $P3
-    # fetch w array
-    $P4 = new ['FixedStringArray']
-    $P4 = 1
-    $P4[0] = 'Foo'
-    $P0 = get_hll_namespace $P4
-    $P2 = $P0.'get_name'()
-    $I2 = elements $P2
-    print $I2
-    print "\n"
-    $S0 = join '::', $P2
-    print $S0
-    print "\n"
-    # fetch w key
-    $P2 = get_hll_namespace ["Foo"]
-    $P2 = $P2.'get_name'()
-    $I2 = elements $P2
-    print $I2
-    print "\n"
-    $S0 = join '::', $P2
-    print $S0
-    print "\n"
-.end
-CODE
-2
-parrot::Foo
-2
-parrot::Foo
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "Sub.get_namespace, get_namespace" );
-.sub 'main' :main
-    $P0 = get_global ["Foo"], "bar"
-    print "ok\n"
-    $P1 = $P0."get_namespace"()
-    $P2 = $P1.'get_name'()
-    $S0 = join '::', $P2
-    print $S0
-    print "\n"
-    $P0()
-.end
-
-.namespace ["Foo"]
-.sub 'bar'
-    $P1 = get_namespace
-    print $P1
-    print "\n"
-.end
-CODE
-ok
-parrot::Foo
-Foo
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "check parrot ns" );
-.sub 'main' :main
-    $P0 = get_global ["String"], "lower"
-    $S0 = $P0("OK\n")
-    print $S0
-.end
-CODE
-ok
-OUTPUT
-
-my $temp_a = "temp_a";
-my $temp_b = "temp_b";
-
-END {
-    unlink( "$temp_a.pir", "$temp_a.pbc", "$temp_b.pir", "$temp_b.pbc" );
-}
-
-open my $S, '>', "$temp_a.pir" or die "Can't write $temp_a.pir";
-print $S <<'EOF';
-.HLL "Foo"
-.namespace ["Foo_A"]
-.sub loada :load
-    $P0 = get_global ["Foo_A"], "A"
-    print "ok 1\n"
-    load_bytecode "temp_b.pbc"
-.end
-
-.sub A
-.end
-EOF
-close $S;
-
-open $S, '>', "$temp_b.pir" or die "Can't write $temp_b.pir";
-print $S <<'EOF';
-.namespace ["Foo_B"]
-.sub loadb :load
-    $P0 = get_global ["Foo_B"], "B"
-    print "ok 2\n"
-.end
-
-.sub B
-.end
-EOF
-
-close $S;
-
-system(".$PConfig{slash}parrot$PConfig{exe} -o $temp_a.pbc $temp_a.pir");
-system(".$PConfig{slash}parrot$PConfig{exe} -o $temp_b.pbc $temp_b.pir");
-
-pir_output_is( <<'CODE', <<'OUTPUT', "HLL and load_bytecode - #38888" );
-.sub main :main
-    load_bytecode "temp_a.pbc"
-    print "ok 3\n"
-.end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "HLL and vars" );
-# initial storage of _tcl global variable...
-
-.HLL '_Tcl'
-
-.sub huh
-  $P0 = new ['Integer']
-  $P0 = 3.14
-  set_global '$variable', $P0
-.end
-
-# start running HLL language
-.HLL 'Tcl'
-
-.sub foo :main
-  huh()
-  $P1 = get_root_namespace ['_tcl']
-  $P2 = $P1['$variable']
-  print $P2
-  print "\n"
-.end
-CODE
-3.14
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "HLL and namespace directives" );
-.HLL '_Tcl'
-.namespace ['Foo'; 'Bar']
-
-.HLL 'Tcl'
-
-.sub main :main
-  $P0 = get_namespace
-  $P1 = $P0.'get_name'()
-  $S0 = join "::", $P1
-  print $S0
-  print "\n"
-  end
-.end
-CODE
-tcl
-OUTPUT
-
-{
-    my $temp_a = "temp_a.pir";
-
-    END {
-        unlink($temp_a);
-    }
-
-    open $S, '>', $temp_a or die "Can't write $temp_a";
-    print $S <<'EOF';
-.HLL 'eek'
-
-.sub foo :load :anon
-  $P1 = new ['String']
-  $P1 = "3.14\n"
-  set_global '$whee', $P1
-.end
-
-.sub bark
-  $P0 = get_global '$whee'
-  print $P0
-.end
-EOF
-    close $S;
-
-    pir_output_is( <<'CODE', <<'OUTPUT', ":anon subs still get default namespace" );
-.HLL 'cromulent'
-
-.sub what
-   load_bytecode 'temp_a.pir'
-  .local pmc var
-   var = get_root_namespace
-   var = var['eek']
-   var = var['bark']
-
-    var()
-.end
-CODE
-3.14
-OUTPUT
-}
-
-SKIP:
-{
-    skip( "immediate test, doesn't with --run-pbc", 1 )
-        if ( exists $ENV{TEST_PROG_ARGS} and $ENV{TEST_PROG_ARGS} =~ m/--run-pbc/ );
-
-    pir_output_is( <<'CODE', <<'OUTPUT', "get_global in current" );
-.HLL 'bork'
-.namespace []
-
-.sub a :immediate
-  $P1 = new ['String']
-  $P1 = "ok\n"
-  set_global ['sub_namespace'], "eek", $P1
-.end
-
-.namespace [ 'sub_namespace' ]
-
-.sub whee :main
- $P1 = get_global 'eek'
- print $P1
-.end
-CODE
-ok
-OUTPUT
-}
-
-open $S, '>', "$temp_b.pir" or die "Can't write $temp_b.pir";
-print $S <<'EOF';
-.HLL 'B'
-.sub b_foo
-    print "b_foo\n"
-.end
-EOF
-close $S;
-
-pir_error_output_like( <<'CODE', <<'OUTPUT', 'export_to() with null destination throws exception' );
-.sub 'test' :main
-    .local pmc nsa, nsb, ar
-
-    ar = new ['ResizableStringArray']
-    push ar, 'foo'
-    nsa = new ['Null']
-    nsb = get_namespace ['B']
-    nsb.'export_to'(nsa, ar)
-.end
-
-.namespace ['B']
-.sub 'foo' :anon
-.end
-CODE
-/^destination namespace not specified\n/
-OUTPUT
-
-pir_error_output_like(
-    <<'CODE', <<'OUTPUT', 'export_to() with null exports default object set !!!UNSPECIFIED!!!' );
-.sub 'test' :main
-    .local pmc nsa, nsb, ar
-
-    ar = new ['Null']
-    nsa = get_namespace
-    nsb = get_namespace ['B']
-    nsb.'export_to'(nsa, ar)
-.end
-
-.namespace ['B']
-.sub 'foo'
-.end
-CODE
-/^exporting default object set not yet implemented\n/
-OUTPUT
-
-pir_error_output_like(
-    <<'CODE', <<'OUTPUT', 'export_to() with empty array exports default object set !!!UNSPECIFIED!!!' );
-.sub 'test' :main
-    .local pmc nsa, nsb, ar
-
-    ar = new ['ResizableStringArray']
-    nsa = get_namespace
-    nsb = get_namespace ['B']
-    nsb.'export_to'(nsa, ar)
-.end
-
-.namespace ['B']
-.sub 'foo'
-.end
-CODE
-/^exporting default object set not yet implemented\n/
-OUTPUT
-
-pir_error_output_like(
-    <<'CODE', <<'OUTPUT', 'export_to() with empty hash exports default object set !!!UNSPECIFIED!!!' );
-.sub 'test' :main
-    .local pmc nsa, nsb, ar
-
-    ar = new ['Hash']
-    nsa = get_namespace
-    nsb = get_namespace ['B']
-    nsb.'export_to'(nsa, ar)
-.end
-
-.namespace ['B']
-.sub 'foo'
-.end
-CODE
-/^exporting default object set not yet implemented\n/
-OUTPUT
-
-pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with array" );
-.HLL 'A'
-.sub main :main
-    a_foo()
-    load_bytecode "$temp_b.pir"
-    .local pmc nsr, nsa, nsb, ar
-    ar = new ['ResizableStringArray']
-    push ar, "b_foo"
-    nsr = get_root_namespace
-    nsa = nsr['a']
-    nsb = nsr['b']
-    nsb."export_to"(nsa, ar)
-    b_foo()
-.end
-
-.sub a_foo
-    print "a_foo\\n"
-.end
-CODE
-a_foo
-b_foo
-OUTPUT
-
-pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with hash (empty value)" );
-.HLL 'A'
-.sub main :main
-    a_foo()
-    load_bytecode "$temp_b.pir"
-    .local pmc nsr, nsa, nsb, ar
-    ar = new ['Hash']
-    ar["b_foo"] = ""
-    nsr = get_root_namespace
-    nsa = nsr['a']
-    nsb = nsr['b']
-    nsb."export_to"(nsa, ar)
-    b_foo()
-.end
-
-.sub a_foo
-    print "a_foo\\n"
-.end
-CODE
-a_foo
-b_foo
-OUTPUT
-
-pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with hash (null value)" );
-.HLL 'A'
-.sub main :main
-    a_foo()
-    load_bytecode "$temp_b.pir"
-    .local pmc nsr, nsa, nsb, ar, nul
-    nul = new ['Null']
-    ar  = new ['Hash']
-    ar["b_foo"] = nul
-    nsr = get_root_namespace
-    nsa = nsr['a']
-    nsb = nsr['b']
-    nsb."export_to"(nsa, ar)
-    b_foo()
-.end
-
-.sub a_foo
-    print "a_foo\\n"
-.end
-CODE
-a_foo
-b_foo
-OUTPUT
-
-pir_error_output_like( <<"CODE", <<'OUTPUT', "export_to -- success with hash (and value)" );
-.HLL 'A'
-.sub main :main
-    a_foo()
-    load_bytecode "$temp_b.pir"
-    .local pmc nsr, nsa, nsb, ar
-    ar = new ['Hash']
-    ar["b_foo"] = "c_foo"
-    nsr = get_root_namespace
-    nsa = nsr['a']
-    nsb = nsr['b']
-    nsb."export_to"(nsa, ar)
-    c_foo()
-    b_foo()
-.end
-
-.sub a_foo
-    print "a_foo\\n"
-.end
-CODE
-/^a_foo
-b_foo
-Could not find non-existent sub b_foo/
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_parent" );
-.sub main :main
-    .local pmc ns
-    ns = get_hll_namespace ['Foo']
-    ns = ns.'get_parent'()
-    print ns
-    print "\n"
-.end
-.namespace ['Foo']
-.sub dummy
-.end
-CODE
-parrot
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_global [''], \"print_ok\"" );
-.namespace ['']
-
-.sub print_ok
-  print "ok\n"
-  .return()
-.end
-
-.namespace ['foo']
-
-.sub main :main
-  $P0 = get_hll_global [''], 'print_ok'
-  $P0()
-  end
-.end
-CODE
-ok
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_global with array ('')" );
-.namespace ['']
-
-.sub print_ok
-  print "ok\n"
-  .return()
-.end
-
-.namespace ['foo']
-
-.sub main :main
-  $P0 = new ['ResizableStringArray']
-  $P0[0] = ''
-  $P0 = get_hll_global $P0, 'print_ok'
-  $P0()
-  end
-.end
-CODE
-ok
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_global with empty array" );
-.namespace []
-
-.sub print_ok
-  print "ok\n"
-  .return()
-.end
-
-.namespace ['foo']
-
-.sub main :main
-  $P0 = new ['ResizablePMCArray']
-  $P0 = 0
-  $P0 = get_hll_global $P0, 'print_ok'
-  $P0()
-  end
-.end
-CODE
-ok
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "Namespace.get_global() with array ('')" );
-.namespace ['']
-
-.sub print_ok
-  print "ok\n"
-  .return()
-.end
-
-.namespace ['foo']
-
-.sub main :main
-  $P1 = new ['ResizableStringArray']
-  $P1[0] = ''
-  $P1 = get_hll_global $P1, 'print_ok'
-  $P1()
-  end
-.end
-CODE
-ok
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "Namespace introspection" );
-.sub main :main
-    .local pmc f
-    f = get_hll_global ['Foo'], 'dummy'
-    f()
-.end
-.namespace ['Foo']
-.sub dummy
-    .local pmc interp, ns_caller
-    interp = getinterp
-    ns_caller = interp['namespace'; 1]
-    print ns_caller
-    print "\n"
-.end
-CODE
-parrot
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "Nested namespace introspection" );
-.sub main :main
-    .local string no_symbol
-
-    .local pmc foo_ns
-    foo_ns = get_hll_namespace [ 'Foo' ]
-    $S0    = foo_ns
-    print "Found namespace: "
-    print $S0
-    print "\n"
-
-    .local pmc bar_ns
-    bar_ns = foo_ns.'find_namespace'( 'Bar' )
-    $S0    = bar_ns
-    print "Found nested namespace: "
-    print $S0
-    print "\n"
-
-    .local pmc baz_ns
-    baz_ns    = bar_ns.'find_namespace'( 'Baz' )
-    no_symbol = 'Baz'
-
-    .local int is_defined
-    is_defined = defined baz_ns
-    if is_defined goto oops
-    goto find_symbols
-
-  oops:
-    print "Found non-null '"
-    print no_symbol
-    print "'\n"
-    .return()
-
-  find_symbols:
-    .local pmc a_sub
-    a_sub = bar_ns.'find_sub'( 'a_sub' )
-    $S0   = a_sub
-    a_sub()
-    print "Found sub: "
-    print $S0
-    print "\n"
-
-    .local pmc some_sub
-    some_sub  = bar_ns.'find_sub'( 'some_sub' )
-    no_symbol = 'some_sub'
-
-    is_defined = defined some_sub
-    if is_defined goto oops
-
-    .local pmc a_var
-    a_var    = bar_ns.'find_var'( 'a_var' )
-    print "Found var: "
-    print a_var
-    print "\n"
-
-    .local pmc some_var
-    some_var    = bar_ns.'find_var'( 'some_var' )
-    no_symbol = 'some_var'
-
-    is_defined = defined some_var
-    if is_defined goto oops
-
-.end
-
-.namespace ['Foo']
-
-.sub some_sub
-.end
-
-.namespace [ 'Foo'; 'Bar' ]
-
-.sub a_sub
-    .local pmc some_var
-    some_var = new ['String']
-    some_var = 'a string PMC'
-    set_hll_global [ 'Foo'; 'Bar' ], 'a_var', some_var
-.end
-CODE
-Found namespace: Foo
-Found nested namespace: Bar
-Found sub: a_sub
-Found var: a string PMC
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace' );
-.sub main :main
-    .local pmc root_ns
-    root_ns = get_root_namespace
-    .local int is_defined
-    is_defined = defined root_ns
-    unless is_defined goto NO_NAMESPACE_FOUND
-        print "Found root namespace.\n"
-    NO_NAMESPACE_FOUND:
-.end
-CODE
-Found root namespace.
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', 'root namespace is not a class' );
-.sub main :main
-    .local pmc root_ns
-    root_ns = get_root_namespace
-    .local pmc root_class
-    root_class = get_class root_ns
-    .local int is_class
-    is_class = defined root_class
-    say is_class
-.end
-CODE
-0
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace "Foo"' );
-.sub main :main
-    .local pmc foo_ns
-    foo_ns = get_root_namespace [ "foo" ]
-    .local int is_defined
-    is_defined = defined foo_ns
-    unless is_defined goto NO_NAMESPACE_FOUND
-        print "Found root namespace 'foo'.\n"
-    NO_NAMESPACE_FOUND:
-.end
-.HLL 'Foo'
-.sub dummy
-.end
-CODE
-Found root namespace 'foo'.
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace "Foo", not there' );
-.sub main :main
-    .local pmc foo_ns
-    foo_ns = get_root_namespace [ "Foo" ]
-    .local int is_defined
-    is_defined = defined foo_ns
-    if is_defined goto NAMESPACE_FOUND
-        print "Didn't find root namespace 'Foo'.\n"
-    NAMESPACE_FOUND:
-.end
-
-.namespace [ "NotFoo" ]
-CODE
-Didn't find root namespace 'Foo'.
-OUTPUT
-
-my $create_nested_key = <<'CREATE_NESTED_KEY';
-.sub create_nested_key
-    .param string name
-    .param pmc other_names :slurpy
-
-    .local pmc key
-    key = new ['Key']
-    key = name
-
-    .local int elem
-    elem = other_names
-
-    if elem goto nested
-    .return( key )
-
-  nested:
-    .local pmc tail
-    tail = create_nested_key(other_names :flat)
-    push key, tail
-
-    .return( key )
-.end
-CREATE_NESTED_KEY
-
-pir_output_is( <<"CODE", <<'OUTPUT', 'get_name()' );
-$create_nested_key
-
-.sub main :main
-    .local pmc key
-    key = create_nested_key( 'SingleName' )
-    print_namespace( key )
-
-    key = create_nested_key( 'Nested', 'Name', 'Space' )
-    print_namespace( key )
-
-    key = get_namespace
-
-    .local pmc ns
-    ns = key.'get_name'()
-
-    .local string ns_name
-    ns_name = join ';', ns
-    print ns_name
-    print "\\n"
-.end
-
-.sub 'print_namespace'
-    .param pmc key
-
-    .local pmc get_ns
-    get_ns = get_global key, 'get_namespace'
-
-    .local pmc ns
-    ns = get_ns()
-
-    .local pmc name_array
-    name_array = ns.'get_name'()
-
-    .local string name
-    name = join ';', name_array
-
-    print name
-    print "\\n"
-.end
-
-.sub get_namespace
-    .local pmc ns
-    ns = get_namespace
-    .return( ns )
-.end
-
-.namespace [ 'SingleName' ]
-
-.sub get_namespace
-    .local pmc ns
-    ns = get_namespace
-    .return( ns )
-.end
-
-.namespace [ 'Nested'; 'Name'; 'Space' ]
-
-.sub get_namespace
-    .local pmc ns
-    ns = get_namespace
-    .return( ns )
-.end
-
-CODE
-parrot;SingleName
-parrot;Nested;Name;Space
-parrot
-OUTPUT
-
-pir_output_is( <<"CODE", <<'OUTPUT', 'add_namespace()' );
-$create_nested_key
-
-.sub main :main
-    .local pmc root_ns
-    root_ns = get_namespace
-
-    .local pmc child_ns
-    child_ns = new ['NameSpace']
-    root_ns.'add_namespace'( 'Nested', child_ns )
-
-    .local pmc grandchild_ns
-    grandchild_ns = new ['NameSpace']
-    child_ns.'add_namespace'( 'Grandkid', grandchild_ns )
-
-    .local pmc great_grandchild_ns
-    great_grandchild_ns = new ['NameSpace']
-    grandchild_ns.'add_namespace'( 'Greatgrandkid', great_grandchild_ns )
-
-    .local pmc parent
-    parent = great_grandchild_ns.'get_parent'()
-    print_ns_name( parent )
-
-    parent = parent.'get_parent'()
-    print_ns_name( parent )
-
-    parent = parent.'get_parent'()
-    print_ns_name( parent )
-.end
-
-.sub print_ns_name
-    .param pmc namespace
-
-    .local pmc ns
-    ns = namespace.'get_name'()
-
-    .local string ns_name
-    ns_name = join ';', ns
-    print ns_name
-    print "\\n"
-.end
-CODE
-parrot;Nested;Grandkid
-parrot;Nested
-parrot
-OUTPUT
-
-pir_output_like( <<'CODE', <<'OUTPUT', 'add_namespace() with error' );
-.sub main :main
-    .local pmc ns_child
-    ns_child = subclass 'NameSpace', 'NSChild'
-
-    .local pmc child
-    child = new ['NSChild']
-
-    .local pmc root_ns
-    root_ns = get_namespace
-
-    root_ns.'add_namespace'( 'Really nested', child )
-
-    .local pmc not_a_ns
-    not_a_ns = new ['Integer']
-
-    push_eh _invalid_ns
-    root_ns.'add_namespace'( 'Nested', not_a_ns )
-    end
-
-_invalid_ns:
-    .local pmc exception
-    .local string message
-    .get_results( exception )
-
-    message = exception
-    print message
-    print "\n"
-.end
-CODE
-/Invalid type \d+ in add_namespace\(\)/
-OUTPUT
-
-pir_output_is( <<"CODE", <<'OUTPUT', 'add_sub()' );
-$create_nested_key
-
-.sub 'main' :main
-    .local pmc report_ns
-    report_ns = get_global 'report_namespace'
-
-    .local pmc key
-    key = create_nested_key( 'Parent' )
-
-    .local pmc parent_ns
-    parent_ns = get_namespace key
-    parent_ns.'add_sub'( 'report_ns', report_ns )
-
-    key = create_nested_key( 'Parent', 'Child' )
-
-    .local pmc child_ns
-    child_ns = get_namespace key
-    child_ns.'add_sub'( 'report_ns', report_ns )
-
-    .local pmc report_namespace
-    report_namespace = get_global [ 'Parent' ], 'report_ns'
-    report_namespace()
-
-    report_namespace = get_global [ 'Parent'; 'Child' ], 'report_ns'
-    report_namespace()
-.end
-
-.sub 'report_namespace'
-    .local pmc namespace
-    namespace = get_namespace
-
-    .local pmc ns
-    ns = namespace.'get_name'()
-
-    .local string ns_name
-    ns_name = join ';', ns
-    print ns_name
-    print "\\n"
-.end
-
-.namespace [ 'Parent' ]
-
-.sub dummy
-.end
-
-.namespace [ 'Parent'; 'Child' ]
-
-.sub dummy
-.end
-CODE
-parrot
-parrot
-OUTPUT
-
-pir_output_like( <<'CODE', <<'OUTPUT', 'add_sub() with error' );
-.sub main :main
-    .local pmc s_child
-    s_child = subclass 'Sub', 'SubChild'
-
-    .local pmc child
-    child = new ['SubChild']
-
-    .local pmc root_ns
-    root_ns = get_namespace
-
-    root_ns.'add_sub'( 'child', child )
-    print "Added sub child\n"
-
-    child = new ['Coroutine']
-    root_ns.'add_sub'( 'coroutine', child )
-    print "Added coroutine\n"
-
-    child = new ['Eval']
-    root_ns.'add_sub'( 'eval', child )
-    print "Added eval\n"
-
-    .local pmc not_a_sub
-    not_a_sub = new ['Integer']
-
-    push_eh _invalid_sub
-    root_ns.'add_sub'( 'Nested', not_a_sub )
-    end
-
-_invalid_sub:
-    .local pmc exception
-    .local string message
-    .get_results( exception )
-
-    message = exception
-    print message
-    print "\n"
-.end
-CODE
-/Added sub child
-Added coroutine
-Added eval
-Invalid type \d+ in add_sub\(\)/
-OUTPUT
-
-pir_output_is( <<"CODE", <<'OUTPUT', 'add_var()' );
-$create_nested_key
-
-.sub 'main' :main
-    .local pmc foo
-    foo = new ['String']
-    foo = 'Foo'
-
-    .local pmc bar
-    bar = new ['String']
-    bar = 'Bar'
-
-    .local pmc key
-    key = create_nested_key( 'Parent' )
-
-    .local pmc parent_ns
-    parent_ns = get_namespace key
-    parent_ns.'add_var'( 'foo', foo )
-
-    key = create_nested_key( 'Parent', 'Child' )
-
-    .local pmc child_ns
-    child_ns = get_namespace key
-    child_ns.'add_var'( 'bar', bar )
-
-    .local pmc my_var
-    my_var = get_global [ 'Parent' ], 'foo'
-    print "Foo: "
-    print my_var
-    print "\\n"
-
-    my_var = get_global [ 'Parent'; 'Child' ], 'bar'
-    print "Bar: "
-    print my_var
-    print "\\n"
-.end
-
-.namespace [ 'Parent' ]
-
-.sub dummy
-.end
-
-.namespace [ 'Parent'; 'Child' ]
-
-.sub dummy
-.end
-CODE
-Foo: Foo
-Bar: Bar
-OUTPUT
-
-pir_output_is( <<"CODE", <<'OUTPUT', 'del_namespace()' );
-$create_nested_key
-
-.sub 'main' :main
-    .local pmc root_ns
-    root_ns = get_namespace
-
-    .local pmc key
-    key      = create_nested_key( 'Parent' )
-
-    .local pmc child_ns
-    child_ns = root_ns.'find_namespace'( key )
-
-    key      = create_nested_key( 'Child' )
-
-    .local pmc grandchild_ns
-    grandchild_ns = child_ns.'find_namespace'( key )
-
-    child_ns.'del_namespace'( 'Child' )
-
-    key      = create_nested_key( 'Child' )
-
-    grandchild_ns = child_ns.'find_namespace'( key )
-    if_null grandchild_ns, CHECK_SIBLING
-    print "Grandchild still exists\\n"
-
-  CHECK_SIBLING:
-    key      = create_nested_key( 'Sibling' )
-    grandchild_ns = child_ns.'find_namespace'( key )
-    if_null grandchild_ns, DELETE_PARENT
-    print "Sibling not deleted\\n"
-
-  DELETE_PARENT:
-    key      = create_nested_key( 'Parent' )
-    root_ns.'del_namespace'( 'Parent' )
-    child_ns = root_ns.'find_namespace'( key )
-    if_null child_ns, CHECK_UNCLE
-    print "Child still exists\\n"
-
-  CHECK_UNCLE:
-    key      = create_nested_key( 'FunUncle' )
-    grandchild_ns = root_ns.'find_namespace'( key )
-    if_null grandchild_ns, DELETE_PARENT
-    print "Fun uncle stuck around\\n"
-
-  ALL_DONE:
-.end
-
-.namespace [ 'FunUncle' ]
-
-.sub dummy
-.end
-
-.namespace [ 'Parent' ]
-
-.sub dummy
-.end
-
-.namespace [ 'Parent'; 'Child' ]
-
-.sub dummy
-.end
-
-.namespace [ 'Parent'; 'Sibling' ]
-
-.sub dummy
-.end
-CODE
-Sibling not deleted
-Fun uncle stuck around
-OUTPUT
-
-pir_output_like( <<'CODE', <<'OUTPUT', 'del_namespace() with error' );
-.sub dummy
-.end
-
-.sub main :main
-    .local pmc not_a_ns
-    not_a_ns = new ['Array']
-
-    set_global 'Not_A_NS', not_a_ns
-
-    .local pmc root_ns
-    root_ns = get_namespace
-    delete_namespace( root_ns, 'dummy' )
-    delete_namespace( root_ns, 'Not_A_NS' )
-.end
-
-.sub delete_namespace
-    .param pmc    root_ns
-    .param string name
-    push_eh _invalid_ns
-    root_ns.'del_namespace'( name )
-
-_invalid_ns:
-    .local pmc exception
-    .local string message
-    .get_results( exception )
-
-    message = exception
-    print message
-    print "\n"
-    .return()
-.end
-CODE
-/Invalid type \d+ for 'dummy' in del_namespace\(\)
-Invalid type \d+ for 'Not_A_NS' in del_namespace\(\)/
-OUTPUT
-
-pir_output_is( <<"CODE", <<'OUTPUT', 'del_sub()' );
-.sub 'main' :main
-    .local pmc root_ns
-    root_ns = get_namespace
-
-    .local pmc parent_ns
-    parent_ns = root_ns.'find_namespace'( 'Parent' )
-    parent_ns.'del_sub'( 'dummy' )
-
-    .local pmc my_sub
-    my_sub = get_global [ 'Parent' ], 'dummy'
-    if_null my_sub, PARENT_NO_DUMMY
-    print "Parent did not delete dummy\\n"
-
-  PARENT_NO_DUMMY:
-    my_sub = get_global [ 'Parent' ], 'no_dummy'
-    my_sub()
-
-    .local pmc child_ns
-    child_ns = parent_ns.'find_namespace'( 'Child' )
-    child_ns.'del_sub'( 'dummy' )
-
-    my_sub = get_global [ 'Parent'; 'Child' ], 'dummy'
-    if_null my_sub, CHILD_NO_DUMMY
-    print "Child did not delete dummy\\n"
-    my_sub()
-
-  CHILD_NO_DUMMY:
-    my_sub = get_global [ 'Parent'; 'Child' ], 'no_dummy'
-    my_sub()
-.end
-
-.namespace [ 'Parent' ]
-
-.sub dummy
-.end
-
-.sub no_dummy
-    print "Parent is no dummy\\n"
-.end
-
-.namespace [ 'Parent'; 'Child' ]
-
-.sub dummy
-    print "Dummy sub!\\n"
-.end
-
-.sub no_dummy
-    print "Child is no dummy\\n"
-.end
-
-CODE
-Parent is no dummy
-Child is no dummy
-OUTPUT
-
-pir_output_like( <<'CODE', <<'OUTPUT', 'del_sub() with error' );
-.sub main :main
-    .local pmc not_a_ns
-    not_a_ns = new ['Array']
-
-    set_global 'Not_A_Sub', not_a_ns
-
-    .local pmc root_ns
-    root_ns = get_namespace
-
-    push_eh _invalid_sub
-    root_ns.'del_sub'( 'Not_A_Sub' )
-
-_invalid_sub:
-    .local pmc exception
-    .local string message
-    .get_results( exception )
-
-    message = exception
-    print message
-    print "\n"
-    .return()
-.end
-CODE
-/Invalid type \d+ for 'Not_A_Sub' in del_sub\(\)/
-OUTPUT
-
-pir_output_is( <<"CODE", <<'OUTPUT', 'del_var()' );
-.sub 'main' :main
-    .local pmc foo
-    foo = new ['String']
-    foo = 'Foo'
-
-    .local pmc bar
-    bar = new ['String']
-    bar = 'Bar'
-
-    set_global [ 'Parent' ],          'Foo', foo
-    set_global [ 'Parent'; 'Child' ], 'Bar', bar
-
-    .local pmc root_ns
-    root_ns = get_namespace
-
-    .local pmc parent_ns
-    parent_ns = root_ns.'find_namespace'( 'Parent' )
-    parent_ns.'del_var'( 'Foo' )
-
-    .local pmc child_ns
-    child_ns = parent_ns.'find_namespace'( 'Child' )
-    child_ns.'del_var'( 'Bar' )
-
-    .local pmc my_var
-    my_var = get_global [ 'Parent' ], 'Foo'
-    if_null my_var, TEST_CHILD_VAR
-    print "Parent Foo exists: "
-    print my_var
-    print "\\n"
-
-  TEST_CHILD_VAR:
-    my_var = get_global [ 'Parent'; 'Child' ], 'Bar'
-    if_null my_var, ALL_DONE
-    print "Child Bar exists: "
-    print my_var
-    print "\\n"
-
-  ALL_DONE:
-.end
-
-.namespace [ 'Parent' ]
-
-.sub dummy
-.end
-
-.namespace [ 'Parent'; 'Child' ]
-
-CODE
-OUTPUT
-
-pir_error_output_like( <<'CODE', <<'OUTPUT', 'overriding find_method()' );
-.sub 'main' :main
-    $P0 = newclass 'Override'
-    $P1 = new ['Override']
-    $P2 = find_method $P1, 'foo'
-.end
-
-.namespace [ 'Override' ]
-
-.sub 'find_method' :vtable
-    .param string method
-    say "Finding method"
-.end
-CODE
-/Finding method/
-OUTPUT
-
-pir_output_is( <<'CODE', <<OUT, "iterate through a NameSpace PMC, RT #39978" );
-.sub main :main
-     $P0 = new ['String']
-     $P0 = "Ook...BANG!\n"
-     set_root_global [ "DUMMY"; "X"; "Y" ], "Explosion", $P0
-
-     $P1 = new ['Integer']
-     $P1 = 0
-     set_root_global [ "DUMMY"; "X"; "Y" ], "T0", $P0
-
-     .local pmc dummy_x_y_ns, it, res
-     dummy_x_y_ns = get_root_namespace [ "DUMMY"; "X"; "Y" ]
-     it   = iter dummy_x_y_ns
-     res  = new ['ResizablePMCArray']
-loop:
-     unless it goto loop_end
-     $S0 = shift it
-     push res, $S0
-     goto loop
-loop_end:
-
-     res.'sort'()
-     $S0 = join ' ', res
-     say $S0
-
-.end
-CODE
-Explosion T0
-OUT
-
-pir_error_output_like( <<'CODE', <<OUT, "NameSpace with no class, RT #55620" );
-.sub 'main' :main
-    $P1 = new ['NameSpace']
-    set_args '(0)', $P1
-    tailcallmethod $P1, 'bob'
-.end
-CODE
-/Null PMC access in get_string()/
-OUT
-
-pir_output_is( <<'CODE', <<OUT, "iterate through a NameSpace PMC" );
-.namespace [ 'bar' ]
-
-.sub 'main' :main
-    .local pmc res
-    res = new ['ResizablePMCArray']
-
-    $P0 = get_namespace
-    say $P0
-    $I0 = elements $P0
-    say $I0
-    $P1 = iter $P0
-  L1:
-    unless $P1 goto L2
-    $P2 = shift $P1
-    $S0 = $P2
-    push res, $S0
-    goto L1
-  L2:
-    res.'sort'()
-    $S0 = join "\n", res
-    say $S0
-    say 'OK'
-.end
-
-.sub 'foo'
-    say 'foo'
-.end
-CODE
-bar
-2
-foo
-main
-OK
-OUT
-
-pir_output_is( <<'CODE', <<'OUT', "make_namespace method");
-.sub 'main' :main
-    $P0 = split ';', 'perl6;Foo;Bar'
-    $P1 = get_root_namespace
-    $P2 = $P1.'make_namespace'($P0)
-    $I0 = isa $P2, 'NameSpace'
-    say $I0
-    $P3 = get_root_namespace ['perl6';'Foo';'Bar']
-    $I0 = isnull $P3
-    say $I0
-    $I0 = issame $P2, $P3
-    say $I0
-.end
-CODE
-1
-0
-1
-OUT
-
-pir_error_output_like( <<'CODE', <<'OUT', 'adding :anon sub to a namespace, TT #56' );
-.namespace ['Foo']
-.sub main :main
-    .const 'Sub' $P0 = 'bar'
-
-    set_global 'ok', $P0
-    $P1 = get_global 'ok'
-    say $P1
-    $S0 = ok()
-    say $S0
-    $S0 = nok()
-    say $S0
-.end
-
-.namespace []
-.sub 'nok' :anon :subid('bar')
-    .return( 'ok 1' )
-.end
-CODE
-/
-ok 1
-Could not find non-existent sub nok/
-OUT
-
-
-pir_output_is( <<'CODE', <<'OUT', 'HLL_map on namespace', todo => 'TT #867');
-.HLL 'tcl'
-
-.sub 'foo' :anon :init
-  $P1 = get_class 'NameSpace'
-  $P2 = subclass $P1, 'BSNS'
-  $P0 = getinterp
-  $P0.'hll_map'($P1, $P2)
-.end
-
-.namespace ['a';'b';'c']
-
-.sub 'hi'
-  noop
-.end
-
-.namespace []
-
-.sub 'blah' :main
-  $P1 = get_hll_namespace ['a';'b';'c']
-  $S0 = typeof $P1
-  print 'ok 1 - '
-  say $S0
-.end
-CODE
-ok 1 - BSNS
-OUT
-
-# Local Variables:
-#   mode: cperl
-#   cperl-indent-level: 4
-#   fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:


More information about the parrot-commits mailing list