From 8d05e9798827f58abf7ac5d5d28d2b03ede92daa Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Sat, 26 Aug 2006 13:00:38 +0000
Subject: bugfix, docs clarification and new tests for 'namespace upvar' [Bug
1546833]
---
ChangeLog | 8 ++++
doc/namespace.n | 9 ++--
generic/tclNamesp.c | 16 ++++++-
tests/upvar.test | 118 ++++++++++++++++++++++++++++++++++++++++++++++------
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
--
cgit v0.12