diff options
author | dgp <dgp@users.sourceforge.net> | 2011-03-09 15:55:19 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2011-03-09 15:55:19 (GMT) |
commit | 2b0f7b4b159055bf1ef1f1a51a31ab0373929824 (patch) | |
tree | bcbc27c8894e3399b916eeaa7a4c4d5a7e6c4736 /tests/namespace.test | |
parent | d413545404999ecc7b1af29a25e9fab165c57c08 (diff) | |
parent | 69bacba44cfb85243b44d53ae35d8ed89527767d (diff) | |
download | tcl-2b0f7b4b159055bf1ef1f1a51a31ab0373929824.zip tcl-2b0f7b4b159055bf1ef1f1a51a31ab0373929824.tar.gz tcl-2b0f7b4b159055bf1ef1f1a51a31ab0373929824.tar.bz2 |
* generic/tclNamesp.c: Tighten the detector of nested [namespace code]
* tests/namespace.test: quoting that the quoted scripts function
properly even in a namespace that contains a custom "namespace"
command. [Bug 3202171]
Diffstat (limited to 'tests/namespace.test')
-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 89f6759..504d532 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -24,6 +24,12 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # 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_* } {} @@ -929,9 +935,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_*]} @@ -942,11 +947,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} @@ -966,6 +971,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_*]} |