diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | doc/namespace.n | 9 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 16 | ||||
| -rw-r--r-- | tests/upvar.test | 118 |
4 files changed, 134 insertions, 17 deletions
@@ -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 |