summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2000-11-23 14:21:59 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2000-11-23 14:21:59 (GMT)
commit35f066289edf0356f517fee2533a240b19246ba0 (patch)
treeb3febe9807cdfe5a68efb4c088770cc58a3dbcac
parent7ccd39dfd67c4ccca3bf1133233bf7ac2b27f6dd (diff)
downloadtcl-35f066289edf0356f517fee2533a240b19246ba0.zip
tcl-35f066289edf0356f517fee2533a240b19246ba0.tar.gz
tcl-35f066289edf0356f517fee2533a240b19246ba0.tar.bz2
Improved use of [uplevel] in unknown. Fixes #123217
-rw-r--r--ChangeLog7
-rw-r--r--library/init.tcl14
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