summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2011-03-09 15:55:19 (GMT)
committerdgp <dgp@users.sourceforge.net>2011-03-09 15:55:19 (GMT)
commit2b0f7b4b159055bf1ef1f1a51a31ab0373929824 (patch)
treebcbc27c8894e3399b916eeaa7a4c4d5a7e6c4736
parentd413545404999ecc7b1af29a25e9fab165c57c08 (diff)
parent69bacba44cfb85243b44d53ae35d8ed89527767d (diff)
downloadtcl-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]
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclNamesp.c22
-rw-r--r--tests/namespace.test23
3 files changed, 31 insertions, 19 deletions
diff --git a/ChangeLog b/ChangeLog
index d544ef6..781589c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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_*]}