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]

5 files changed, 22 insertions, 22 deletions

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]]