bugfix, docs clarification and new tests for 'namespace upvar' [Bug 1546833]

4 files changed, 134 insertions, 17 deletions

diff --git a/ChangeLog b/ChangeLog
index 5712c00..875f18b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2006-08-26  Miguel Sofer  <msofer@users.sf.net>
+
+	* doc/namespace.n:
+	* generic/tclNamesp.c:
+	* tests/upvar.test: bugfix, docs clarification and new tests for
+	[namespace upvar] as follow up to [Bug 1546833], reported by Will
+	Duquette. 
+	
 2006-08-24  Kevin Kenny  <kennykb@acm.org>
 
 	* library/tzdata: Regenerated, including several new files,
diff --git a/doc/namespace.n b/doc/namespace.n
index 150e7ee..99d885c 100644
--- a/doc/namespace.n
+++ b/doc/namespace.n
@@ -7,7 +7,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: namespace.n,v 1.20 2006/02/01 18:27:43 dgp Exp $
+'\" RCS: @(#) $Id: namespace.n,v 1.21 2006/08/26 13:00:38 msofer Exp $
 '\" 
 .so man.macros
 .TH namespace n 8.5 Tcl "Tcl Built-In Commands"
@@ -251,9 +251,12 @@ the names of currently defined namespaces.
 .TP
 \fBnamespace upvar\fR \fInamespace\fR \fIotherVar myVar \fR?\fIotherVar myVar \fR...
 This command arranges for one or more local variables in the current
-procedure to refer to variables in \fInamespace\fR. The command 
+procedure to refer to variables in \fInamespace\fR. The namespace name is
+resolved as described in section \fBNAME RESOLUTION\fR.
+The command 
 \fBnamespace upvar $ns a b\fR has the same behaviour as
-\fBupvar 0 $ns::a b\fR.  
+\fBupvar 0 $ns::a b\fR, with the sole exception of the resolution rules
+used for qualified namespace or variable names. 
 \fBnamespace upvar\fR returns an empty string.
 .TP
 \fBnamespace unknown\fR ?\fIscript\fR?
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 15ed318..89f1618 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.97 2006/08/11 15:16:21 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.98 2006/08/26 13:00:39 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -4600,6 +4600,18 @@ NamespaceUpvarCmd(
     if (result != TCL_OK) {
 	return TCL_ERROR;
     }
+    if (nsPtr == NULL) {
+	/*
+	 * The namespace does not exist, leave an error message.
+	 */
+
+	Tcl_Obj *resPtr;
+
+	TclNewObj(resPtr);
+	TclFormatObj(NULL, resPtr, "namespace \"%s\" does not exist", objv[2]);
+	Tcl_SetObjResult(interp, resPtr);
+	return TCL_ERROR;
+    }
 
     objc -= 3;
     objv += 3;
@@ -4613,10 +4625,10 @@ NamespaceUpvarCmd(
 	otherPtr = TclObjLookupVar(interp, objv[0], NULL,
 		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
 		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+	Tcl_PopCallFrame(interp);
 	if (otherPtr == NULL) {
 	    return TCL_ERROR;
 	}
-	Tcl_PopCallFrame(interp);
 
 	/*
 	 * Create the new variable and link it to otherPtr
diff --git a/tests/upvar.test b/tests/upvar.test
index 134e0c1..2b8bbab 100644
--- a/tests/upvar.test
+++ b/tests/upvar.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: upvar.test,v 1.12 2006/04/06 18:19:28 dgp Exp $
+# RCS: @(#) $Id: upvar.test,v 1.13 2006/08/26 13:00:39 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -414,6 +414,7 @@ catch {unset a}
 # assume that the behaviour of variables once the link is established has 
 # already been tested above.
 #
+#
 
 # Clear out any namespaces called test_ns_*
 catch {namespace delete {expand}[namespace children :: test_ns_*]}
@@ -422,34 +423,127 @@ namespace eval test_ns_0 {
     variable x test_ns_0
 }
 
-namespace eval test_ns_1 {
-    variable x test_ns_1
-}
-
-namespace eval test_ns_2 {}
-
 set x test_global
 
 test upvar-NS-1.1 {nsupvar links to correct variable} \
     -body {
-	namespace eval test_ns_2 {
+	namespace eval test_ns_1 {
 	    namespace upvar ::test_ns_0 x w
 	    set w
 	}
     } \
-    -result {test_ns_0}
+    -result {test_ns_0} \
+    -cleanup {namespace delete test_ns_1}
 
 test upvar-NS-1.2 {nsupvar links to correct variable} \
     -body {
-	namespace eval test_ns_2 {
+	namespace eval test_ns_1 {
 	    proc a {} {
 		namespace upvar ::test_ns_0 x w
 		set w
 	    }
-	    return [a][rename a {}]
+	    return [a]
+	}
+    } \
+    -result {test_ns_0} \
+    -cleanup {namespace delete test_ns_1}
+
+test upvar-NS-1.3 {nsupvar links to correct variable} \
+    -body {
+	namespace eval test_ns_1 {
+	    namespace upvar test_ns_0 x w
+	    set w
+	}
+    } \
+    -result {namespace "test_ns_0" does not exist} \
+    -returnCodes error \
+    -cleanup {namespace delete test_ns_1}
+
+test upvar-NS-1.4 {nsupvar links to correct variable} \
+    -body {
+	namespace eval test_ns_1 {
+	    proc a {} {
+		namespace upvar test_ns_0 x w
+		set w
+	    }
+	    return [a]
+	}
+    } \
+    -result {namespace "test_ns_0" does not exist} \
+    -returnCodes error \
+    -cleanup {namespace delete test_ns_1}
+
+test upvar-NS-1.5 {nsupvar links to correct variable} \
+    -body {
+	namespace eval test_ns_1 {
+	    namespace eval test_ns_0 {}
+	    namespace upvar test_ns_0 x w
+	    set w
+	}
+    } \
+    -result {can't read "w": no such variable} \
+    -returnCodes error \
+    -cleanup {namespace delete test_ns_1}
+
+test upvar-NS-1.6 {nsupvar links to correct variable} \
+    -body {
+	namespace eval test_ns_1 {
+	    namespace eval test_ns_0 {}
+	    proc a {} {
+		namespace upvar test_ns_0 x w
+		set w
+	    }
+	    return [a]
 	}
     } \
-    -result {test_ns_0}
+    -result {can't read "w": no such variable} \
+    -returnCodes error \
+    -cleanup {namespace delete test_ns_1}
+
+test upvar-NS-1.7 {nsupvar links to correct variable} \
+    -body {
+	namespace eval test_ns_1 {
+	    namespace eval test_ns_0 {
+		variable x test_ns_1::test_ns_0
+	    }
+	    namespace upvar test_ns_0 x w
+	    set w
+	}
+    } \
+    -result {test_ns_1::test_ns_0} \
+    -cleanup {namespace delete test_ns_1}
+
+test upvar-NS-1.8 {nsupvar links to correct variable} \
+    -body {
+	namespace eval test_ns_1 {
+	    namespace eval test_ns_0 {
+		variable x test_ns_1::test_ns_0
+	    }
+	    proc a {} {
+		namespace upvar test_ns_0 x w
+		set w
+	    }
+	    return [a]
+	}
+    } \
+    -result {test_ns_1::test_ns_0} \
+    -cleanup {namespace delete test_ns_1}
+
+test upvar-NS-1.9 {nsupvar links to correct variable} \
+    -body {
+	namespace eval test_ns_1 {
+	    variable x test_ns_1
+	    proc a {} {
+		namespace upvar test_ns_0 x w
+		set w
+	    }
+	    return [a]
+	}
+    } \
+    -result {namespace "test_ns_0" does not exist} \
+    -returnCodes error \
+    -cleanup {namespace delete test_ns_1}
+
 
 # cleanup
 ::tcltest::cleanupTests