Tcl Source Code

Artifact 58db0a6ecfe899e783cbd844e6a98b3cecd6b399:

Index: library/package.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/package.tcl,v
retrieving revision 1.21
diff -u -r1.21 package.tcl
--- library/package.tcl	28 Oct 2002 16:34:25 -0000	1.21
+++ library/package.tcl	21 Feb 2003 05:18:41 -0000
@@ -477,6 +477,14 @@
     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
+
 	# we can't use glob in safe interps, so enclose the following
 	# in a catch statement, where we get the pkgIndex files out
 	# of the subdirectories
@@ -484,7 +492,7 @@
 	    foreach file [glob -directory $dir -join -nocomplain \
 		    * 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 {
@@ -494,23 +502,50 @@
 	    }
 	}
 	set dir [lindex $use_path end]
-	set file [file join $dir pkgIndex.tcl]
-	# safe interps usually don't have "file readable", nor stderr channel
-	if {([interp issafe] || [file readable $file]) && \
-		![info exists procdDirs($dir)]} {
-	    if {[catch {source $file} msg] && ![interp issafe]}  {
-		tclLog "error reading package index file $file: $msg"
-	    } else {
-		set procdDirs($dir) 1
+	if {![info exists procdDirs($dir)]} {
+	    set file [file join $dir pkgIndex.tcl]
+	    # safe interps usually don't have "file readable", 
+	    # nor stderr channel
+	    if {([interp issafe] || [file readable $file])} {
+		if {[catch {source $file} msg] && ![interp issafe]}  {
+		    tclLog "error reading package index file $file: $msg"
+		} else {
+		    set procdDirs($dir) 1
+		}
 	    }
 	}
+
 	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
     }
 }