Improved use of [uplevel] in unknown. Fixes #123217

2 files changed, 14 insertions, 7 deletions

diff --git a/ChangeLog b/ChangeLog
index 0ec1c25..cea22e7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2000-11-23  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* library/init.tcl (unknown): Added specific level parameters to
+	  all uplevel invokations to boost performance; didn't dare touch
+	  the "namespace inscope" stuff though, since it looks sensitive
+	  to me!  Should fix Bug #123217, though testing is tricky...
+
 2000-11-21  Andreas Kupries  <a.kupries@westend.com>
 
 	* All of the changes below are described in TIP #7 ~ Specification
diff --git a/library/init.tcl b/library/init.tcl
index ad0d697..426d651 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.41 2000/05/18 21:37:19 hobbs Exp $
+# RCS: @(#) $Id: init.tcl,v 1.42 2000/11/23 14:21:59 dkf 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 $cmd $arglist} result]
+	set ret [catch {uplevel 1 $cmd $arglist} result]
         if {$ret == 0} {
             return $result
         } else {
@@ -228,7 +228,7 @@ proc unknown args {
 		if {[string equal [info commands console] ""]} {
 		    set redir ">&@stdout <@stdin"
 		}
-		return [uplevel exec $redir $new [lrange $args 1 end]]
+		return [uplevel 1 exec $redir $new [lrange $args 1 end]]
 	    }
 	}
 	set errorCode $savedErrorCode
@@ -244,7 +244,7 @@ proc unknown args {
 	if {[info exists newcmd]} {
 	    tclLog $newcmd
 	    history change $newcmd 0
-	    return [uplevel $newcmd]
+	    return [uplevel 1 $newcmd]
 	}
 
 	set ret [catch {set cmds [info commands $name*]} msg]
@@ -256,7 +256,7 @@ proc unknown args {
 		"error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
 	}
 	if {[llength $cmds] == 1} {
-	    return [uplevel [lreplace $args 0 0 $cmds]]
+	    return [uplevel 1 [lreplace $args 0 0 $cmds]]
 	}
 	if {[llength $cmds]} {
 	    if {[string equal $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 {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 namespace current]
+    set ns [uplevel 1 [list namespace current]]
     set patternList [auto_qualify $pattern $ns]
 
     auto_load_index