From ab4eb3fe6a6e7f494057f9bc9af0c1a4489c5f88 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 11 Dec 2000 04:17:38 +0000 Subject: 2000-12-10 Don Porter * 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] --- ChangeLog | 14 ++++++++++++++ library/init.tcl | 10 +++++----- library/msgcat/msgcat.tcl | 14 +++++++------- library/msgcat/pkgIndex.tcl | 2 +- library/opt/optparse.tcl | 16 ++++++++-------- library/opt/pkgIndex.tcl | 2 +- 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 + + * 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 * 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]] -- cgit v0.12