diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | library/package.tcl | 89 |
2 files changed, 85 insertions, 11 deletions
@@ -1,5 +1,12 @@ 2003-09-24 Vince Darley <vincentdarley@users.sourceforge.net> + * library/package.tcl (tcl::MacPkgUnknown, tcl::MacOSXPkgUnknown): + Minor performance tweaks to reduce the number of [file] invocations. + Meant to improve startup times, at least a little bit. + (The generic equivalent patch was applied on 2003-02-21). + +2003-09-24 Vince Darley <vincentdarley@users.sourceforge.net> + * trace.test: removed 'knownBug' from a test which doesn't illustrate a bug, just a bad test. diff --git a/library/package.tcl b/library/package.tcl index 545f6a9..77812f3 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -3,7 +3,7 @@ # utility procs formerly in init.tcl which can be loaded on demand # for package management. # -# RCS: @(#) $Id: package.tcl,v 1.25 2003/07/24 08:45:18 rmax Exp $ +# RCS: @(#) $Id: package.tcl,v 1.26 2003/09/24 18:07:45 vincentdarley Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -582,11 +582,19 @@ proc tcl::MacOSXPkgUnknown {original name version {exact {}}} { set old_path [set use_path $auto_path] while {[llength $use_path]} { set dir [lindex $use_path end] + + # Make sure we only scan each directory one time. + if {[info exists tclSeenPath($dir)]} { + set use_path [lrange $use_path 0 end-1] + continue + } + set tclSeenPath($dir) 1 + # get the pkgIndex files out of the subdirectories foreach file [glob -directory $dir -join -nocomplain \ * Resources Scripts pkgIndex.tcl] { set dir [file dirname $file] - if {[file readable $file] && ![info exists procdDirs($dir)]} { + if {![info exists procdDirs($dir)] && [file readable $file]} { if {[catch {source $file} msg]} { tclLog "error reading package index file $file: $msg" } else { @@ -595,12 +603,36 @@ proc tcl::MacOSXPkgUnknown {original name version {exact {}}} { } } set use_path [lrange $use_path 0 end-1] - if {[string compare $old_path $auto_path]} { - foreach dir $auto_path { + + # Check whether any of the index scripts we [source]d above + # set a new value for $::auto_path. If so, then find any + # new directories on the $::auto_path, and lappend them to + # the $use_path we are working from. This gives index scripts + # the (arguably unwise) power to expand the index script search + # path while the search is in progress. + set index 0 + if {[llength $old_path] == [llength $auto_path]} { + foreach dir $auto_path old $old_path { + if {$dir ne $old} { + # This entry in $::auto_path has changed. + break + } + incr index + } + } + + # $index now points to the first element of $auto_path that + # has changed, or the beginning if $auto_path has changed length + # Scan the new elements of $auto_path for directories to add to + # $use_path. Don't add directories we've already seen, or ones + # already on the $use_path. + foreach dir [lrange $auto_path $index end] { + if {![info exists tclSeenPath($dir)] + && ([lsearch -exact $use_path $dir] == -1) } { lappend use_path $dir } - set old_path $auto_path } + set old_path $auto_path } } @@ -631,16 +663,27 @@ proc tcl::MacPkgUnknown {original name version {exact {}}} { # the first set of pkgIndex.tcl files set old_path [set use_path $auto_path] while {[llength $use_path]} { - # We look for pkgIndex TEXT resources in the resource fork of shared libraries + # We look for pkgIndex TEXT resources in the resource fork of + # shared libraries set dir [lindex $use_path end] + + # Make sure we only scan each directory one time. + if {[info exists tclSeenPath($dir)]} { + set use_path [lrange $use_path 0 end-1] + continue + } + set tclSeenPath($dir) 1 + foreach x [concat [list $dir] [glob -directory $dir -nocomplain *] ] { - if {[file isdirectory $x] && ![info exists procdDirs($x)]} { + if {![info exists procdDirs($x)] && [file isdirectory $x]} { set dir $x foreach x [glob -directory $dir -nocomplain *.shlb] { if {[file isfile $x]} { set res [resource open $x] foreach y [resource list TEXT $res] { - if {[string equal $y "pkgIndex"]} {source -rsrc pkgIndex} + if {[string equal $y "pkgIndex"]} { + source -rsrc pkgIndex + } } catch {resource close $res} } @@ -649,12 +692,36 @@ proc tcl::MacPkgUnknown {original name version {exact {}}} { } } set use_path [lrange $use_path 0 end-1] - if {[string compare $old_path $auto_path]} { - foreach dir $auto_path { + + # Check whether any of the index scripts we [source]d above + # set a new value for $::auto_path. If so, then find any + # new directories on the $::auto_path, and lappend them to + # the $use_path we are working from. This gives index scripts + # the (arguably unwise) power to expand the index script search + # path while the search is in progress. + set index 0 + if {[llength $old_path] == [llength $auto_path]} { + foreach dir $auto_path old $old_path { + if {$dir ne $old} { + # This entry in $::auto_path has changed. + break + } + incr index + } + } + + # $index now points to the first element of $auto_path that + # has changed, or the beginning if $auto_path has changed length + # Scan the new elements of $auto_path for directories to add to + # $use_path. Don't add directories we've already seen, or ones + # already on the $use_path. + foreach dir [lrange $auto_path $index end] { + if {![info exists tclSeenPath($dir)] + && ([lsearch -exact $use_path $dir] == -1) } { lappend use_path $dir } - set old_path $auto_path } + set old_path $auto_path } } |