diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 22 | ||||
| -rw-r--r-- | tests/namespace.test | 23 |
3 files changed, 31 insertions, 19 deletions
@@ -1,5 +1,10 @@ 2011-03-09 Don Porter <dgp@users.sourceforge.net> + * 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] + * doc/tclvars.n: Formatting fix. Thanks to Pat Thotys. 2011-03-08 Jan Nijtmans <nijtmans@users.sf.net> diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 1747c99..16f14e9 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -3007,7 +3007,7 @@ NamespaceCodeCmd( { Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; - register char *arg, *p; + register char *arg; int length; if (objc != 3) { @@ -3017,21 +3017,17 @@ NamespaceCodeCmd( /* * If "arg" is already a scoped value, then return it directly. + * Take care to only check for scoping in precisely the style that + * [::namespace code] generates it. Anything more forgiving can have + * the effect of failing in namespaces that contain their own custom + " "namespace" command. [Bug 3202171]. */ arg = TclGetStringFromObj(objv[2], &length); - while (*arg == ':') { - arg++; - length--; - } - if (*arg=='n' && length>17 && strncmp(arg, "namespace", 9)==0) { - for (p=arg+9 ; isspace(UCHAR(*p)) ; p++) { - /* empty body: skip over whitespace */ - } - if (*p=='i' && (p+7 <= arg+length) && strncmp(p, "inscope", 7)==0) { - Tcl_SetObjResult(interp, objv[2]); - return TCL_OK; - } + if (*arg==':' && length > 20 + && strncmp(arg, "::namespace inscope ", 20) == 0) { + Tcl_SetObjResult(interp, objv[2]); + return TCL_OK; } /* 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_*]} |