Attachment "package.diff" to
ticket [687906ffff]
added by
vincentdarley
2003-02-17 18:16:11.
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 17 Feb 2003 11:03:57 -0000
@@ -477,6 +477,11 @@
set old_path [set use_path $auto_path]
while {[llength $use_path]} {
set dir [lindex $use_path end]
+ 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 +489,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,18 +499,20 @@
}
}
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]} {
+ if {!($old_path eq $auto_path)} {
foreach dir $auto_path {
lappend use_path $dir
}
