diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | library/init.tcl | 12 | ||||
| -rw-r--r-- | tests/autoMkindex.test | 14 | ||||
| -rw-r--r-- | tests/pkg/magicchar2.tcl | 1 |
4 files changed, 37 insertions, 4 deletions
@@ -1,5 +1,19 @@ 2000-01-28 Eric Melski <ericm@scriptics.com> + * tests/pkg/magicchar2.tcl: + * tests/autoMkindex.test: Test for auto loader fix (bug #2480). + + * library/init.tcl: auto_load was using [info commands $name] to + determine if a given command was available; if the command name + had * or [] it, this would fail because info commands uses + glob-style matching. This is fixed. (Bug #2480). + + * tests/pkg/spacename.tcl: + * tests/pkgMkIndex.test: Tests for fix for bug #2360. + + * library/package.tcl: Fixed to extract only the first element of + the list returned by auto_qualify (bug #2360). + * tests/pkg/magicchar.tcl: * tests/autoMkindex.test: Test for fix for bug #2611. diff --git a/library/init.tcl b/library/init.tcl index 1797d50..c5fff21 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.36 2000/01/24 02:30:08 hobbs Exp $ +# RCS: @(#) $Id: init.tcl,v 1.37 2000/01/29 00:12:46 ericm Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -305,11 +305,17 @@ proc auto_load {cmd {namespace {}}} { if {![auto_load_index]} { return 0 } - foreach name $nameList { if {[info exists auto_index($name)]} { uplevel #0 $auto_index($name) - if {[string compare [info commands $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. Since we really want an exact match, + # a better route is to use + # lsearch -exact [info commands] $name + if {[lsearch -exact [info commands] $name] != -1 } { return 1 } } diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test index bab9e43..c033bf0 100644 --- a/tests/autoMkindex.test +++ b/tests/autoMkindex.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: autoMkindex.test,v 1.9 2000/01/28 16:38:34 ericm Exp $ +# RCS: @(#) $Id: autoMkindex.test,v 1.10 2000/01/29 00:12:46 ericm Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -198,6 +198,18 @@ test autoMkindex-5.1 {escape magic tcl chars in general code} { } set result } {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]} +test autoMkindex-5.2 {correctly locate auto loaded procs with []} { + file delete tclIndex + set res {} + if { ![catch {auto_mkindex . pkg/magicchar2.tcl}] } { + # Make a slave interp to test the autoloading + set c [interp create] + $c eval {lappend auto_path [pwd]} + set res [$c eval {catch {{[magic mojo proc]}}}] + interp delete $c + } + set res +} 0 # Clean up. diff --git a/tests/pkg/magicchar2.tcl b/tests/pkg/magicchar2.tcl new file mode 100644 index 0000000..2e7b47f --- /dev/null +++ b/tests/pkg/magicchar2.tcl @@ -0,0 +1 @@ +proc {[magic mojo proc]} {} {} |