diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2011-03-09 19:42:51 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2011-03-09 19:42:51 (GMT) |
commit | 62c99a1fde06fc47b9a61460f1ab2fdfc7ede16f (patch) | |
tree | 2e14ad1406867a283bb0948904f3b53c11f2b9b2 /tests | |
parent | 1111254200cc2b8bc8aa2d899f43d56884f1f1cb (diff) | |
parent | 66c00a872668c60fedb51c5b242df305c7557826 (diff) | |
download | tcl-62c99a1fde06fc47b9a61460f1ab2fdfc7ede16f.zip tcl-62c99a1fde06fc47b9a61460f1ab2fdfc7ede16f.tar.gz tcl-62c99a1fde06fc47b9a61460f1ab2fdfc7ede16f.tar.bz2 |
Merge to feature branch
Diffstat (limited to 'tests')
-rw-r--r-- | tests/namespace.test | 23 |
1 files changed, 17 insertions, 6 deletions
diff --git a/tests/namespace.test b/tests/namespace.test index 643514a..9d7cb59 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -24,6 +24,12 @@ testConstraint memory [llength [info commands memory]] # Clear out any namespaces called test_ns_* catch {namespace delete {*}[namespace children :: test_ns_*]} +proc fq {ns} { + if {[string match ::* $ns]} {return $ns} + set current [uplevel 1 {namespace current}] + return [string trimright $current :]::[string trimleft $ns :] +} + test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} { namespace children :: test_ns_* } {} @@ -928,9 +934,8 @@ test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} { } [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}] test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} { namespace eval test_ns_1 {} - namespace children [namespace current] \ - [string trimright [namespace current] :]::test_ns_1 -} [string trimright [namespace current] :]::test_ns_1 + namespace children [namespace current] [fq test_ns_1] +} [fq test_ns_1] test namespace-22.1 {NamespaceCodeCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} @@ -941,11 +946,11 @@ test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} { namespace eval test_ns_1 { proc cmd {} {return "test_ns_1::cmd"} } - namespace code {namespace inscope ::test_ns_1 cmd} -} {namespace inscope ::test_ns_1 cmd} + namespace code {::namespace inscope ::test_ns_1 cmd} +} {::namespace inscope ::test_ns_1 cmd} test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} { namespace code {namespace inscope ::test_ns_1 cmd} -} {namespace inscope ::test_ns_1 cmd} +} {::namespace inscope :: {namespace inscope ::test_ns_1 cmd}} test namespace-22.4 {NamespaceCodeCmd, in :: namespace} { namespace code unknown } {::namespace inscope :: unknown} @@ -965,6 +970,12 @@ test namespace-22.6 {NamespaceCodeCmd, in other namespace} { namespace code {set v} }] } {42} +test namespace-22.7 {NamespaceCodeCmd, Bug 3202171} { + namespace eval demo { + proc namespace args {puts $args} + ::namespace code {namespace inscope foo} + } +} [list ::namespace inscope [fq demo] {namespace inscope foo}] test namespace-23.1 {NamespaceCurrentCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} |