summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2001-04-07 02:08:05 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2001-04-07 02:08:05 (GMT)
commitf4aae297ab93a93609f6e467d30b0e022440daab (patch)
tree27e01be7c5657ec2023a9068839d964791e9e29d
parent9777db5094c42eabbad41300b9a61e15b1998aae (diff)
downloadtcl-f4aae297ab93a93609f6e467d30b0e022440daab.zip
tcl-f4aae297ab93a93609f6e467d30b0e022440daab.tar.gz
tcl-f4aae297ab93a93609f6e467d30b0e022440daab.tar.bz2
Corrected behaviour of [namespace code] (bug #219385, patch #403530)
-rw-r--r--doc/namespace.n4
-rw-r--r--generic/tclNamesp.c12
-rw-r--r--library/init.tcl4
-rw-r--r--tests/namespace-old.test8
-rw-r--r--tests/namespace.test17
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_*]}