summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2000-12-11 04:17:38 (GMT)
committerdgp <dgp@users.sourceforge.net>2000-12-11 04:17:38 (GMT)
commitab4eb3fe6a6e7f494057f9bc9af0c1a4489c5f88 (patch)
tree3558459e0bea4593330821ed820ea77f36f43326
parent19df5d993a9f6e55e773ea93d3632c770756358b (diff)
downloadtcl-ab4eb3fe6a6e7f494057f9bc9af0c1a4489c5f88.zip
tcl-ab4eb3fe6a6e7f494057f9bc9af0c1a4489c5f88.tar.gz
tcl-ab4eb3fe6a6e7f494057f9bc9af0c1a4489c5f88.tar.bz2
2000-12-10 Don Porter <dgp@users.sourceforge.net>
* library/init.tcl: * library/msgcat/msgcat.tcl: * library/msgcat/pkgIndex.tcl: * library/opt/optparse.tcl: * library/opt/pkgIndex.tcl: Where [uplevel] is used in a proc to evaluate a Tcl built-in command in the caller's context, the built-in commands are now fully namespace-qualified. This prevents problems when the caller context is in a namespace where the built-in command name has been used by a command in the namespace. (For example, [::ns::set] might be called instead of the intended [::set]). [Bug #119422, Patch #102545]
-rw-r--r--ChangeLog14
-rw-r--r--library/init.tcl10
-rw-r--r--library/msgcat/msgcat.tcl14
-rw-r--r--library/msgcat/pkgIndex.tcl2
-rw-r--r--library/opt/optparse.tcl16
-rw-r--r--library/opt/pkgIndex.tcl2
6 files changed, 36 insertions, 22 deletions
diff --git a/ChangeLog b/ChangeLog
index 27e2813..fd83086 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2000-12-10 Don Porter <dgp@users.sourceforge.net>
+
+ * library/init.tcl:
+ * library/msgcat/msgcat.tcl:
+ * library/msgcat/pkgIndex.tcl:
+ * library/opt/optparse.tcl:
+ * library/opt/pkgIndex.tcl: Where [uplevel] is used in a proc
+ to evaluate a Tcl built-in command in the caller's context,
+ the built-in commands are now fully namespace-qualified. This
+ prevents problems when the caller context is in a namespace where
+ the built-in command name has been used by a command in the
+ namespace. (For example, [::ns::set] might be called instead
+ of the intended [::set]). [Bug #119422, Patch #102545]
+
2000-12-09 jeff hobbs <jhobbs@interwoven.com>
* win/tclWinTime.c (CalibrationThread): added lint return value to
diff --git a/library/init.tcl b/library/init.tcl
index 865db47..b6ba69f 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.43 2000/12/09 00:11:54 hobbs Exp $
+# RCS: @(#) $Id: init.tcl,v 1.44 2000/12/11 04:17:38 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -165,7 +165,7 @@ proc unknown args {
set cmd [lindex $args 0]
if {[regexp "^namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
set arglist [lrange $args 1 end]
- set ret [catch {uplevel 1 $cmd $arglist} result]
+ set ret [catch {uplevel 1 ::$cmd $arglist} result]
if {$ret == 0} {
return $result
} else {
@@ -188,7 +188,7 @@ proc unknown args {
return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
}
set unknown_pending($name) pending;
- set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
+ set ret [catch {auto_load $name [uplevel 1 {::namespace current}]} msg]
unset unknown_pending($name);
if {$ret != 0} {
append errorInfo "\n (autoloading \"$name\")"
@@ -286,7 +286,7 @@ proc auto_load {cmd {namespace {}}} {
global auto_index auto_oldpath auto_path
if {[string length $namespace] == 0} {
- set namespace [uplevel 1 [list namespace current]]
+ set namespace [uplevel 1 [list ::namespace current]]
}
set nameList [auto_qualify $cmd $namespace]
# workaround non canonical auto_index entries that might be around
@@ -461,7 +461,7 @@ proc auto_import {pattern} {
return
}
- set ns [uplevel 1 [list namespace current]]
+ set ns [uplevel 1 [list ::namespace current]]
set patternList [auto_qualify $pattern $ns]
auto_load_index
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index c4c4d81..27c4c57 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -10,9 +10,9 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: msgcat.tcl,v 1.9 2000/08/11 00:45:32 ericm Exp $
+# RCS: @(#) $Id: msgcat.tcl,v 1.10 2000/12/11 04:17:38 dgp Exp $
-package provide msgcat 1.2
+package provide msgcat 1.2.1
namespace eval msgcat {
namespace export mc mcset mcmset mclocale mcpreferences mcunknown mcmax
@@ -49,7 +49,7 @@ proc msgcat::mc {src args} {
# Check for the src in each namespace starting from the local and
# ending in the global.
- set ns [uplevel {namespace current}]
+ set ns [uplevel 1 [list ::namespace current]]
while {$ns != ""} {
foreach loc $::msgcat::loclist {
@@ -66,7 +66,7 @@ proc msgcat::mc {src args} {
set ns [namespace parent $ns]
}
# we have not found the translation
- return [uplevel 1 [list [namespace origin mcunknown] \
+ return [uplevel 1 [list [::namespace origin mcunknown] \
$::msgcat::locale $src] $args]
}
@@ -136,7 +136,7 @@ proc msgcat::mcload {langdir} {
incr x
set fid [open $langfile "r"]
fconfigure $fid -encoding utf-8
- uplevel [list eval [read $fid]]
+ uplevel 1 [read $fid]
close $fid
}
}
@@ -161,7 +161,7 @@ proc msgcat::mcset {locale src {dest ""}} {
set dest $src
}
- set ns [uplevel {namespace current}]
+ set ns [uplevel 1 [list ::namespace current]]
set ::msgcat::msgs([string tolower $locale],$ns,$src) $dest
return $dest
@@ -186,7 +186,7 @@ proc msgcat::mcmset {locale pairs } {
}
set locale [string tolower $locale]
- set ns [uplevel {namespace current}]
+ set ns [uplevel 1 [list ::namespace current]]
foreach {src dest} $pairs {
set ::msgcat::msgs($locale,$ns,$src) $dest
diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
index af800dc..acdd20c 100644
--- a/library/msgcat/pkgIndex.tcl
+++ b/library/msgcat/pkgIndex.tcl
@@ -1 +1 @@
-package ifneeded msgcat 1.2 [list source [file join $dir msgcat.tcl]]
+package ifneeded msgcat 1.2.1 [list source [file join $dir msgcat.tcl]]
diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl
index 0f6019a..f3c82a1 100644
--- a/library/opt/optparse.tcl
+++ b/library/opt/optparse.tcl
@@ -8,9 +8,9 @@
# on it. If your code does rely on this package you
# may directly incorporate this code into your application.
#
-# RCS: @(#) $Id: optparse.tcl,v 1.4 2000/07/18 21:30:41 ericm Exp $
+# RCS: @(#) $Id: optparse.tcl,v 1.5 2000/12/11 04:17:39 dgp Exp $
-package provide opt 0.4.1
+package provide opt 0.4.2
namespace eval ::tcl {
@@ -239,7 +239,7 @@ proc ::tcl::OptKeyDelete {key} {
# Assign a temporary key, call OptKeyParse and then free the storage
proc ::tcl::OptParse {desc arglist} {
set tempkey [OptKeyRegister $desc];
- set ret [catch {uplevel [list ::tcl::OptKeyParse $tempkey $arglist]} res];
+ set ret [catch {uplevel 1 [list ::tcl::OptKeyParse $tempkey $arglist]} res];
OptKeyDelete $tempkey;
return -code $ret $res;
}
@@ -252,7 +252,7 @@ proc ::tcl::OptParse {desc arglist} {
# (the other will be sets to their default value)
# into local variable named "Args".
proc ::tcl::OptProc {name desc body} {
- set namespace [uplevel namespace current];
+ set namespace [uplevel 1 [list ::namespace current]];
if { ([string match "::*" $name])
|| ([string compare $namespace "::"]==0)} {
# absolute name or global namespace, name is the key
@@ -262,7 +262,7 @@ proc ::tcl::OptProc {name desc body} {
set key "${namespace}::${name}";
}
OptKeyRegister $desc $key;
- uplevel [list proc $name args "set Args \[::tcl::OptKeyParse $key \$args\]\n$body"];
+ uplevel 1 [list ::proc $name args "set Args \[::tcl::OptKeyParse $key \$args\]\n$body"];
return $key;
}
# Check that a argument has been given
@@ -307,7 +307,7 @@ proc ::tcl::OptProcArgGiven {argname} {
# Advance to next description
proc OptNextDesc {descName} {
- uplevel [list Lvarincr $descName {0 1}];
+ uplevel 1 [list Lvarincr $descName {0 1}];
}
# Get the current description, eventually descend
@@ -365,7 +365,7 @@ proc ::tcl::OptProcArgGiven {argname} {
}
# Advance to next argument
proc OptNextArg {argsName} {
- uplevel [list Lvarpop1 $argsName];
+ uplevel 1 [list Lvarpop1 $argsName];
}
#######
@@ -1055,7 +1055,7 @@ proc ::tcl::Lassign {list args} {
set lg [llength $list];
foreach vname $args {
if {$i>=$lg} break
- uplevel [list set $vname [lindex $list $i]];
+ uplevel 1 [list ::set $vname [lindex $list $i]];
incr i;
}
return $lg;
diff --git a/library/opt/pkgIndex.tcl b/library/opt/pkgIndex.tcl
index 260e572..2de9531 100644
--- a/library/opt/pkgIndex.tcl
+++ b/library/opt/pkgIndex.tcl
@@ -8,4 +8,4 @@
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
-package ifneeded opt 0.4.1 [list source [file join $dir optparse.tcl]]
+package ifneeded opt 0.4.2 [list source [file join $dir optparse.tcl]]