Tcl Source Code

Artifact 330787c5853d56f8b52d5e6acde23f27a125f4ee:

Index: generic/tclInterp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInterp.c,v
retrieving revision 1.51
diff -u -r1.51 tclInterp.c
--- generic/tclInterp.c	18 Nov 2004 21:00:50 -0000	1.51
+++ generic/tclInterp.c	22 Nov 2004 19:48:42 -0000
@@ -61,26 +61,44 @@
   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 @@
 	}\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\
Index: tests/unixInit.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/unixInit.test,v
retrieving revision 1.42
diff -u -r1.42 unixInit.test
--- tests/unixInit.test	19 Nov 2004 17:29:31 -0000	1.42
+++ tests/unixInit.test	22 Nov 2004 19:48:42 -0000
@@ -95,10 +95,7 @@
 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 @@
     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 @@
     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 @@
     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 @@
     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]
     }