* 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]

3 files changed, 45 insertions, 21 deletions

diff --git a/ChangeLog b/ChangeLog
index c1bcda1..18f4f72 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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]
     }