diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclInterp.c | 40 | ||||
| -rw-r--r-- | tests/unixInit.test | 17 |
3 files changed, 45 insertions, 21 deletions
@@ -1,3 +1,12 @@ +2004-11-22 Don Porter <dgp@users.sourceforge.net> + + * generic/tclInterp.c: Restored several directories to the search + * tests/unixInit.test: path used to locate init.tcl within [tclInit]. + This change does not restore any directories to the encoding search + path, so should still avoid the price of an unreasonably large number + of filesystem accesses during encoding initialization at startup + [Bug 976438] + 2004-11-22 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclPathObj.c: fix and new test for [Bug 1043129] in diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 21571d4..194944b 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInterp.c,v 1.51 2004/11/18 21:00:50 dgp Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.52 2004/11/22 21:24:30 dgp Exp $ */ #include "tclInt.h" @@ -61,26 +61,44 @@ static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\ proc tclInit {} {\n\ global tcl_libPath tcl_library\n\ global env tclDefaultLibrary\n\ + variable ::tcl::LibPath\n\ rename tclInit {}\n\ set errors {}\n\ - set dirs {}\n\ + set LibPath {}\n\ if {[info exists tcl_library]} {\n\ - lappend dirs $tcl_library\n\ + lappend LibPath $tcl_library\n\ } else {\n\ if {[info exists env(TCL_LIBRARY)]} {\n\ - set env(TCL_LIBRARY) [file join [pwd] $env(TCL_LIBRARY)]\n\ - lappend dirs $env(TCL_LIBRARY)\n\ + lappend LibPath $env(TCL_LIBRARY)\n\ + if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail]} {\n\ + if {$tail ne [info tclversion]} {\n\ + lappend LibPath [file join [file dirname\\\n\ + $env(TCL_LIBRARY)] tcl[info tclversion]]\n\ + }\n\ + }\n\ }\n\ - catch {\n\ - lappend dirs $tclDefaultLibrary\n\ + if {[catch {\n\ + lappend LibPath $tclDefaultLibrary\n\ unset tclDefaultLibrary\n\ + }]} {\n\ + lappend LibPath [::tcl::pkgconfig get scriptdir,runtime]\n\ }\n\ + set parentDir [file normalize [file dirname [file dirname\\\n\ + [info nameofexecutable]]]]\n\ + set grandParentDir [file dirname $parentDir]\n\ + lappend LibPath [file join $parentDir lib tcl[info tclversion]]\n\ + lappend LibPath [file join $grandParentDir lib tcl[info tclversion]]\n\ + lappend LibPath [file join $parentDir library]\n\ + lappend LibPath [file join $grandParentDir library]\n\ + lappend LibPath [file join $grandParentDir\\\n\ + tcl[info patchlevel] library]\n\ + lappend LibPath [file join [file dirname $grandParentDir]\\\n\ + tcl[info patchlevel] library]\n\ catch {\n\ - set dirs [concat $dirs $tcl_libPath]\n\ + set LibPath [concat $LibPath $tcl_libPath]\n\ }\n\ - lappend dirs [::tcl::pkgconfig get scriptdir,runtime]\n\ }\n\ - foreach i $dirs {\n\ + foreach i $LibPath {\n\ set tcl_library $i\n\ set tclfile [file join $i init.tcl]\n\ if {[file exists $tclfile]} {\n\ @@ -93,7 +111,7 @@ static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\ }\n\ }\n\ set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\ - append msg \" $dirs\n\n\"\n\ + append msg \" $LibPath\n\n\"\n\ append msg \"$errors\n\n\"\n\ append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\ error $msg\n\ diff --git a/tests/unixInit.test b/tests/unixInit.test index a303fd3..22840fb 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unixInit.test,v 1.42 2004/11/19 17:29:31 dgp Exp $ +# RCS: @(#) $Id: unixInit.test,v 1.43 2004/11/22 21:24:31 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -95,10 +95,7 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} proc getlibpath [list [list program [interpreter]]] { set f [open "|[list $program]" w+] fconfigure $f -buffering none - puts $f { - puts [list $::env(TCL_LIBRARY) [tcl::pkgconfig get scriptdir,runtime]] - exit - } + puts $f {puts $::tcl::LibPath; exit} set path [gets $f] close $f return $path @@ -125,8 +122,8 @@ test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} \ set prefix [file dirname [file dirname [interpreter]]] set x {} - lappend x [string compare [lindex $path 0] $prefix/$installLib] - lappend x [string compare [lindex $path 4] [file dirname $prefix]/$developLib] + lappend x [string compare [lindex $path 2] $prefix/$installLib] + lappend x [string compare [lindex $path 6] [file dirname $prefix]/$developLib] set x } {0 0} test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -constraints { @@ -206,7 +203,7 @@ test unixInit-2.6 {TclpInitLibraryPath: executable relative} \ makeFile {} [file join tmp sparkly lib tcl[info tclversion] init.tcl] set x [lrange [getlibpath [file join [temporaryDirectory] tmp sparkly \ - bin tcltest]] 0 1] + bin tcltest]] 2 3] removeFile [file join tmp sparkly lib tcl[info tclversion] init.tcl] removeDirectory [file join tmp sparkly lib tcl[info tclversion]] removeDirectory [file join tmp sparkly lib] @@ -289,7 +286,7 @@ test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} {unix noSp file mkdir /tmp/library/ close [open /tmp/library/init.tcl w] - set x [lrange [getlibpath /tmp/sparkly/tcltest] 0 4] + set x [lrange [getlibpath /tmp/sparkly/tcltest] 2 6] file delete -force /tmp/sparkly file delete -force /tmp/library @@ -311,7 +308,7 @@ test unixInit-2.10 {TclpInitLibraryPath: executable relative} -constraints { cd $libDir } -body { # Checking for Bug 832657 - set x [lrange [getlibpath [file join .. bin tcltest]] 2 3] + set x [lrange [getlibpath [file join .. bin tcltest]] 4 5] foreach p $x { lappend y [file normalize $p] } |