diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | library/init.tcl | 33 |
2 files changed, 24 insertions, 16 deletions
@@ -1,3 +1,10 @@ +2003-09-23 Don Porter <dgp@users.sourceforge.net> + + * library/init.tcl (auto_load, auto_import): Expanded Eric Melski's + 2000-01-28 fix for [Bug 218871] to all potentially troubled uses of + [info commands] on input data, where glob-special characters could + cause problems. + 2003-09-20 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/expr.test (expr-23.4): Prevented accidental wrapping round diff --git a/library/init.tcl b/library/init.tcl index 789d295..8957ae4 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.56 2003/03/04 23:46:00 dgp Exp $ +# RCS: @(#) $Id: init.tcl,v 1.57 2003/09/23 04:49:40 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -340,8 +340,17 @@ proc auto_load {cmd {namespace {}}} { lappend nameList $cmd foreach name $nameList { if {[info exists auto_index($name)]} { - uplevel #0 $auto_index($name) - return [expr {[info commands $name] != ""}] + namespace eval :: $auto_index($name) + # There's a couple of ways to look for a command of a given + # name. One is to use + # info commands $name + # Unfortunately, if the name has glob-magic chars in it like * + # or [], it may not match. For our purposes here, a better + # route is to use + # namespace which -command $name + if {[namespace which -command $name] ne ""} { + return 1 + } } } if {![info exists auto_path]} { @@ -353,15 +362,8 @@ proc auto_load {cmd {namespace {}}} { } foreach name $nameList { if {[info exists auto_index($name)]} { - uplevel #0 $auto_index($name) - # There's a couple of ways to look for a command of a given - # name. One is to use - # info commands $name - # Unfortunately, if the name has glob-magic chars in it like * - # or [], it may not match. For our purposes here, a better - # route is to use - # namespace which -command $name - if { ![string equal [namespace which -command $name] ""] } { + namespace eval :: $auto_index($name) + if {[namespace which -command $name] ne ""} { return 1 } } @@ -514,10 +516,9 @@ proc auto_import {pattern} { foreach pattern $patternList { foreach name [array names auto_index $pattern] { - if {[string equal "" [info commands $name]] - && [string equal [namespace qualifiers $pattern] \ - [namespace qualifiers $name]]} { - uplevel #0 $auto_index($name) + if {([namespace which -command $name] eq "") + && ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} { + namespace eval :: $auto_index($name) } } } |