* 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.

4 files changed, 38 insertions, 22 deletions

diff --git a/ChangeLog b/ChangeLog
index ab51db4..71adb1a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+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-09  Donal K. Fellows  <dkf@users.sf.net>
 
 	* tests/dstring.test, tests/init.test, tests/link.test: Update more of
diff --git a/doc/tclvars.n b/doc/tclvars.n
index b7f17b4..27f9cc2 100644
--- a/doc/tclvars.n
+++ b/doc/tclvars.n
@@ -363,7 +363,7 @@ binary number.
 .RE
 .PP
 .RS
-If \Btcl_precision\fB is not zero, then when Tcl converts a floating
+If \fBtcl_precision\fR is not zero, then when Tcl converts a floating
 point number, it creates a decimal representation of at most 
 \fBtcl_precision\fR significant digits; the result may be shorter if
 the shorter result represents the original number exactly. If no
@@ -372,7 +372,7 @@ of the original number, the one that is closest to the original
 number is chosen.
 If the original number lies precisely between two equally accurate
 decimal representations, then the one with an even value for the least
-significant digit is chosen; for instance, if tcl_precision is 3, then
+significant digit is chosen; for instance, if \fBtcl_precision\fR is 3, then
 0.3125 will convert to 0.312, not 0.313, while 0.6875 will convert to
 0.688, not 0.687. Any string of trailing zeroes that remains is trimmed.
 .RE
@@ -396,7 +396,7 @@ variable.
 .RE
 .PP
 .RS
-Valid values for \Btcl_precision\fR range from 0 to 17.
+Valid values for \fBtcl_precision\fR range from 0 to 17.
 .RE
 .TP
 \fBtcl_rcFileName\fR
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index a777d27..1d84131 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -3077,7 +3077,7 @@ NamespaceCodeCmd(
 {
     Namespace *currNsPtr;
     Tcl_Obj *listPtr, *objPtr;
-    register const char *arg, *p;
+    register const char *arg;
     int length;
 
     if (objc != 3) {
@@ -3087,21 +3087,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 cda26f8..fe087a5 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_*]}