package unknown performance on MacOS and MacOS X

2 files changed, 85 insertions, 11 deletions

diff --git a/ChangeLog b/ChangeLog
index c7eee11..14561c8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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
     }
 }