Attachment "catch_open.patch" to
ticket [1969717fff]
added by
decosterjos
2008-05-22 23:09:56.
--- /target/staff/decoster/tmp/tcltk8.5/tcl/library/package.tcl 2007-10-01 11:40:05.000000000 +0200
+++ /target/staff/decoster/tmp/tcltk-8.5.2/tcl8.5.2/library/package.tcl 2008-05-22 17:48:21.000000000 +0200
@@ -485,11 +485,14 @@
foreach file [glob -directory $dir -join -nocomplain \
* pkgIndex.tcl] {
set dir [file dirname $file]
- if {![info exists procdDirs($dir)] && [file readable $file]} {
- if {[catch {source $file} msg]} {
- tclLog "error reading package index file $file: $msg"
- } else {
- set procdDirs($dir) 1
+ if {![info exists procdDirs($dir)]} {
+ if {![catch {open $file r} filePtr]} {
+ close $filePtr
+ if {[catch {source $file} msg]} {
+ tclLog "error reading package index file $file: $msg"
+ } else {
+ set procdDirs($dir) 1
+ }
}
}
}
@@ -499,7 +502,14 @@
set file [file join $dir pkgIndex.tcl]
# safe interps usually don't have "file readable",
# nor stderr channel
- if {([interp issafe] || [file readable $file])} {
+ set ip_is_safe [interp issafe]
+ if {[catch {open $file r} filePtr]} {
+ set file_is_readable 0
+ } else {
+ close $filePtr
+ set file_is_readable 1
+ }
+ if {($ip_is_safe || $file_is_readable)} {
if {[catch {source $file} msg] && ![interp issafe]} {
tclLog "error reading package index file $file: $msg"
} else {
