From f4aae297ab93a93609f6e467d30b0e022440daab Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Sat, 7 Apr 2001 02:08:05 +0000 Subject: Corrected behaviour of [namespace code] (bug #219385, patch #403530) --- doc/namespace.n | 4 ++-- generic/tclNamesp.c | 12 ++++++++---- library/init.tcl | 4 ++-- tests/namespace-old.test | 8 ++++---- tests/namespace.test | 17 ++++++++++++++--- 5 files changed, 30 insertions(+), 15 deletions(-) diff --git a/doc/namespace.n b/doc/namespace.n index 31b3c79..1b7a438 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -6,7 +6,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.6 2000/05/11 00:17:29 hobbs Exp $ +'\" RCS: @(#) $Id: namespace.n,v 1.7 2001/04/07 02:08:05 msofer Exp $ '\" .so man.macros .TH namespace n 8.0 Tcl "Tcl Built-In Commands" @@ -60,7 +60,7 @@ Then \fBeval "$script x y"\fR can be executed in any namespace (assuming the value of \fBscript\fR has been passed in properly) and will have the same effect as the command -\fBnamespace eval ::a::b {foo bar x y}\fR. +\fB::namespace eval ::a::b {foo bar x y}\fR. This command is needed because extensions like Tk normally execute callback scripts in the global namespace. diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index ba35fad..f34eafe 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -19,7 +19,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.19 2001/03/24 01:14:27 hobbs Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.20 2001/04/07 02:09:18 msofer Exp $ */ #include "tclInt.h" @@ -2641,10 +2641,10 @@ NamespaceChildrenCmd(dummy, interp, objc, objv) * Here "arg" can be a list. "namespace code arg" produces a result * equivalent to that produced by the command * - * list namespace inscope [namespace current] $arg + * list ::namespace inscope [namespace current] $arg * * However, if "arg" is itself a scoped value starting with - * "namespace inscope", then the result is just "arg". + * "::namespace inscope", then the result is just "arg". * * Results: * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. @@ -2678,6 +2678,10 @@ NamespaceCodeCmd(dummy, interp, objc, objv) */ arg = Tcl_GetStringFromObj(objv[2], &length); + while (*arg == ':') { + arg++; + length--; + } if ((*arg == 'n') && (length > 17) && (strncmp(arg, "namespace", 9) == 0)) { for (p = (arg + 9); (*p == ' '); p++) { @@ -2700,7 +2704,7 @@ NamespaceCodeCmd(dummy, interp, objc, objv) listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj("namespace", -1)); + Tcl_NewStringObj("::namespace", -1)); Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("inscope", -1)); diff --git a/library/init.tcl b/library/init.tcl index 644fba3..6dcf926 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -3,7 +3,7 @@ # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # -# RCS: @(#) $Id: init.tcl,v 1.45 2001/04/06 17:57:31 dgp Exp $ +# RCS: @(#) $Id: init.tcl,v 1.46 2001/04/07 02:10:17 msofer Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -163,7 +163,7 @@ proc unknown args { # then concatenate its arguments onto the end and evaluate it. set cmd [lindex $args 0] - if {[regexp "^namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} { + if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} { set arglist [lrange $args 1 end] set ret [catch {uplevel 1 ::$cmd $arglist} result] if {$ret == 0} { diff --git a/tests/namespace-old.test b/tests/namespace-old.test index 42e2967..5137051 100644 --- a/tests/namespace-old.test +++ b/tests/namespace-old.test @@ -14,7 +14,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-old.test,v 1.5 2000/04/10 17:19:02 ericm Exp $ +# RCS: @(#) $Id: namespace-old.test,v 1.6 2001/04/07 02:11:19 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -804,17 +804,17 @@ test namespace-old-10.4 {command "namespace code" gets current namesp context} { namespace eval test_ns_inscope { namespace code {"1 2 3" "4 5" 6} } -} {namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}} +} {::namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}} test namespace-old-10.5 {with one arg, first "scope" sticks} { set sval [namespace eval test_ns_inscope {namespace code {one two}}] namespace code $sval -} {namespace inscope ::test_ns_inscope {one two}} +} {::namespace inscope ::test_ns_inscope {one two}} test namespace-old-10.6 {with many args, each "scope" adds new args} { set sval [namespace eval test_ns_inscope {namespace code {one two}}] namespace code "$sval three" -} {namespace inscope ::test_ns_inscope {one two} three} +} {::namespace inscope ::test_ns_inscope {one two} three} test namespace-old-10.7 {scoped commands work with eval} { set cref [namespace eval test_ns_inscope {namespace code show}] diff --git a/tests/namespace.test b/tests/namespace.test index da884eb..234f90b 100644 --- a/tests/namespace.test +++ b/tests/namespace.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: namespace.test,v 1.13 2000/05/11 00:17:29 hobbs Exp $ +# RCS: @(#) $Id: namespace.test,v 1.14 2001/04/07 02:12:30 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -694,12 +694,23 @@ test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} { } {namespace inscope ::test_ns_1 cmd} test namespace-22.4 {NamespaceCodeCmd, in :: namespace} { namespace code unknown -} {namespace inscope :: unknown} +} {::namespace inscope :: unknown} test namespace-22.5 {NamespaceCodeCmd, in other namespace} { namespace eval test_ns_1 { namespace code cmd } -} {namespace inscope ::test_ns_1 cmd} +} {::namespace inscope ::test_ns_1 cmd} +test namespace-22.6 {NamespaceCodeCmd, in other namespace} { + namespace eval test_ns_1 { + variable v 42 + } + namespace eval test_ns_2 { + proc namespace args {} + } + namespace eval test_ns_2 [namespace eval test_ns_1 { + namespace code {set v} + }] +} {42} test namespace-23.1 {NamespaceCurrentCmd, bad args} { catch {eval namespace delete [namespace children :: test_ns_*]} -- cgit v0.12