* Backport of several bug fixes from HEAD to core-8-3-1-branch

FossilOrigin-Name: a44fa8045154481ccf04a807289ab46f4020ff5a

16 files changed, 211 insertions, 45 deletions

diff --git a/ChangeLog b/ChangeLog
index 6a1aa58..2458079 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,51 @@
+2001-08-24  Don Porter <dgp@users.sourceforge.net>
+
+	* tests/unixInit.test (unixInit-2.9): Corrected expected result
+        to match Tcl's quirky construction of its init library path.
+
+        * tests/ioUtil.test (ioUtil-3.*): Corrected errors in tests
+        revealed by fix of overagressive compiler.  [Bug 451200]
+
+        * doc/tclsh.1:  Added note that the tclsh program is frequently
+        installed with the Tcl version numer as part of the name.
+        [Patch 402725]
+
+        * generic/tclPkg.c:
+        * tests/pkg.test:  [package forget] now forgets all of the
+        package arguments it receives, not stopping when a package is
+        not found.  [Bug 415273]
+
+        * doc/pkgMkindex.n:
+        * library/package.tcl:  Corrected documentation and usage
+        message of [pkg_mkIndex].
+
+        * tests/unixInit.test (unixInit-2.8): Added extra constraint,
+        notInstalledInTmp, to stop this test from damaging installations
+        in /tmp; not much fun to have to reinstall the Tcl library every
+        time you run the test suite!
+
+        * tests/unixInit.test (unixInit-2.9):
+        * unix/tclUnixInit.c (TclpInitLibraryPath):
+        * win/tclWinInit.c (TclpInitLibraryPath):  Corrected buggy
+        construction of search path entries relative to executable.
+        Added test for bad construction.  [Bug 438014]
+
+        * tests/cmdMZ.test (cmdMZ-1.4): added notLinux constraint to test
+        to prevent failure message on Linux due to OS caching bug.
+
+        * doc/library.n:  
+        * library/init.tcl:
+        * tests/autoMkindex.t*: Modified [auto_import] to apply
+        pattern matching in the [namespace import] style.  [Bug 420186]
+        ***POTENTIAL INCOMPATIBILITY*** for any callers of [auto_import]
+        from outside Tcl that expect the pattern matching to be like that
+        of [string match].
+
+        * tools/genStubs.tcl: Add a package require of Tcl 8
+        at the beginning of the script so that the script
+        will print a descriptive error message when run
+        in an old Tcl 7 shell.
+
 2001-08-23  Andreas Kupries <andreas_kupries@users.sourceforge.net>
 
 	* win/tclWinPipe.c (BuildCommandLine): Fixed tcl Bug
diff --git a/doc/library.n b/doc/library.n
index 16746c6..40cf96c 100644
--- a/doc/library.n
+++ b/doc/library.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: library.n,v 1.11.2.2 2001/04/03 22:06:43 hobbs Exp $
+'\" RCS: @(#) $Id: library.n,v 1.11.2.3 2001/08/24 16:19:09 dgp Exp $
 .so man.macros
 .TH library n "8.0" Tcl "Tcl Built-In Commands"
 .BS
@@ -81,7 +81,8 @@ the imported commands specified by \fIpattern\fR reside in an
 autoloaded library.  If so, the commands are loaded so that they will
 be available to the interpreter for creating the import links.  If the
 commands do not reside in an autoloaded library, \fBauto_import\fR
-does nothing.
+does nothing.  The pattern matching is performed according to the
+matching rules of \fBnamespace import\fR.
 .TP
 \fBauto_load \fIcmd\fR
 This command attempts to load the definition for a Tcl command named
diff --git a/doc/pkgMkIndex.n b/doc/pkgMkIndex.n
index 0c60659..cb6e328 100644
--- a/doc/pkgMkIndex.n
+++ b/doc/pkgMkIndex.n
@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: pkgMkIndex.n,v 1.9.2.1 2001/04/03 22:06:43 hobbs Exp $
+'\" RCS: @(#) $Id: pkgMkIndex.n,v 1.9.2.2 2001/08/24 16:19:09 dgp Exp $
 '\" 
 .so man.macros
 .TH pkg_mkIndex n 8.3 Tcl "Tcl Built-In Commands"
@@ -15,7 +15,7 @@ pkg_mkIndex \- Build an index for automatic loading of packages
 .SH SYNOPSIS
 .nf
 .VS 8.3.0
-\fBpkg_mkIndex ?\fI\-lazy\fR? ?\fI\-load pkgPat\fR? ?\fI\-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
+\fBpkg_mkIndex ?\fI\-direct\fR?  ?\fI\-lazy\fR?  ?\fI\-load pkgPat\fR? ?\fI\-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
 .VE
 .fi
 .BE
@@ -102,6 +102,10 @@ interpreters.
 .SH OPTIONS
 The optional switches are:
 .TP 15
+\fB\-direct\fR
+The generated index will implement direct loading of the package
+upon \fBpackage require\fR.  This is the default.
+.TP 15
 \fB\-lazy\fR
 The generated index will manage to delay loading the package until the
 use of one of the commands provided by the package, instead of loading
diff --git a/doc/tclsh.1 b/doc/tclsh.1
index 76d5aaf..f948486 100644
--- a/doc/tclsh.1
+++ b/doc/tclsh.1
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: tclsh.1,v 1.3 1999/05/13 01:50:13 stanton Exp $
+'\" RCS: @(#) $Id: tclsh.1,v 1.3.10.1 2001/08/24 16:19:09 dgp Exp $
 '\" 
 .so man.macros
 .TH tclsh 1 "" Tcl "Tcl Applications"
@@ -80,6 +80,14 @@ instead to start up \fBtclsh\fR to reprocess the entire script.
 When \fBtclsh\fR starts up, it treats all three lines as comments,
 since the backslash at the end of the second line causes the third
 line to be treated as part of the comment on the second line.
+.PP
+.VS
+You should note that it is also common practise to install tclsh with
+its version number as part of the name.  This has the advantage of
+allowing multiple versions of Tcl to exist on the same system at once,
+but also the disadvantage of making it harder to write scripts that
+start up uniformly across different versions of Tcl.
+.VE
 
 .SH "VARIABLES"
 .PP
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 11211d9..d049056 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclPkg.c,v 1.5 1999/09/21 04:20:40 hobbs Exp $
+ * RCS: @(#) $Id: tclPkg.c,v 1.5.2.1 2001/08/24 16:19:09 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -503,7 +503,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
 		keyString = Tcl_GetString(objv[i]);
 		hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
 		if (hPtr == NULL) {
-		    return TCL_OK;
+		    continue;	
 		}
 		pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
 		Tcl_DeleteHashEntry(hPtr);
diff --git a/library/init.tcl b/library/init.tcl
index 9478b98..f5c8c96 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
 # Default system startup file for Tcl-based applications.  Defines
 # "unknown" procedure and auto-load facilities.
 #
-# RCS: @(#) $Id: init.tcl,v 1.39.2.2 2001/04/03 22:54:38 hobbs Exp $
+# RCS: @(#) $Id: init.tcl,v 1.39.2.3 2001/08/24 16:19:09 dgp Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -467,9 +467,10 @@ proc auto_import {pattern} {
     auto_load_index
 
     foreach pattern $patternList {
-        foreach name [array names auto_index] {
-            if {[string match $pattern $name] && \
-		    [string equal "" [info commands $name]]} {
+        foreach name [array names auto_index $pattern] {
+            if {[string equal "" [info commands $name]]
+		    && [string equal [namespace qualifiers $pattern] \
+				     [namespace qualifiers $name]]} {
                 uplevel #0 $auto_index($name)
             }
         }
diff --git a/library/package.tcl b/library/package.tcl
index 89d2d95..9dcd475 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -3,7 +3,7 @@
 # utility procs formerly in init.tcl which can be loaded on demand
 # for package management.
 #
-# RCS: @(#) $Id: package.tcl,v 1.14.2.1 2001/04/03 22:54:38 hobbs Exp $
+# RCS: @(#) $Id: package.tcl,v 1.14.2.2 2001/08/24 16:19:10 dgp Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -87,7 +87,7 @@ proc pkg_compareExtension { fileName {ext {}} } {
 
 proc pkg_mkIndex {args} {
     global errorCode errorInfo
-    set usage {"pkg_mkIndex ?-direct? ?-verbose? ?-load pattern? ?--? dir ?pattern ...?"};
+    set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"};
 
     set argCount [llength $args]
     if {$argCount < 1} {
diff --git a/tests/autoMkindex.tcl b/tests/autoMkindex.tcl
index 2756358..8e9e74d 100644
--- a/tests/autoMkindex.tcl
+++ b/tests/autoMkindex.tcl
@@ -71,3 +71,12 @@ namespace eval ::buried {
     {my proc} mycmd5 args {return "mycmd"}
 }
 {::buried::my proc} mycmd6 args {return "another"}
+
+# A correctly functioning [auto_import] won't choke when a child
+# namespace [namespace import]s from its parent.
+#
+namespace eval ::parent::child {
+    namespace import ::parent::*
+}
+proc ::parent::child::test {} {}
+
diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test
index 4be6bee..d6ae35f 100644
--- a/tests/autoMkindex.test
+++ b/tests/autoMkindex.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: autoMkindex.test,v 1.11 2000/04/10 17:18:57 ericm Exp $
+# RCS: @(#) $Id: autoMkindex.test,v 1.11.2.1 2001/08/24 16:19:10 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -70,7 +70,7 @@ test autoMkindex-1.3 {examine tclIndex} {
     }
     namespace delete tcl_autoMkindex_tmp
     set ::result
-} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {normal $element} {top $element}"
+} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {normal $element} {top $element}"
 
 
 test autoMkindex-2.1 {commands on the autoload path can be imported} {
@@ -138,7 +138,7 @@ test autoMkindex-3.2 {auto_mkindex_parser::command} {
 
     AutoMkindexTestReset
     set ::result
-} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}"
+} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}"
 
 
 test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index f3f562e..546d193 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -11,12 +11,14 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdMZ.test,v 1.7 2000/04/10 17:18:57 ericm Exp $
+# RCS: @(#) $Id: cmdMZ.test,v 1.7.2.1 2001/08/24 16:19:10 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
+set tcltest::testConstraints(notLinux) \
+	[expr {![string equal Linux $tcl_platform(os)]}]
 
 # Tcl_PwdObjCmd
 
@@ -29,7 +31,10 @@ test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} {
 test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} {
     expr [string length pwd]>0
 } 1
-test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unixOnly} {
+test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unixOnly notLinux} {
+    # We don't want this test to run on Linux because they do a
+    # permissions caching trick which causes this to fail.  The
+    # caching is incorrect, but we have no control over that.
     file delete -force foo
     file mkdir foo
     set cwd [pwd]
diff --git a/tests/ioUtil.test b/tests/ioUtil.test
index de37cf8..55ada89 100644
--- a/tests/ioUtil.test
+++ b/tests/ioUtil.test
@@ -8,7 +8,7 @@
 # See the file "license.terms" for information on usage and redistribution 
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 
 # 
-# RCS: @(#) $Id: ioUtil.test,v 1.8 2000/04/10 17:19:01 ericm Exp $
+# RCS: @(#) $Id: ioUtil.test,v 1.8.2.1 2001/08/24 16:19:10 dgp Exp $
  
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -192,9 +192,9 @@ test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.}
 }
 
 test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {
-    catch {file exists __testOpenFileChannel1%__.fil} err1
-    catch {file exists __testOpenFileChannel2%__.fil} err2
-    catch {file exists __testOpenFileChannel3%__.fil} err3
+    catch {file exists testOpenFileChannel1%.fil} err1
+    catch {file exists testOpenFileChannel2%.fil} err2
+    catch {file exists testOpenFileChannel3%.fil} err3
     catch {file exists __testOpenFileChannel1%__.fil} err4
     catch {file exists __testOpenFileChannel2%__.fil} err5
     catch {file exists __testOpenFileChannel3%__.fil} err6
@@ -247,15 +247,15 @@ test openfilechannelt-1.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenF
 
 	catch {
 		close [open testOpenFileChannel1%.fil r]
-		catch {close [open testOpenFileChannel2%.fil r]}
+		catch {close [open testOpenFileChannel2%.fil r]} msg1
 		close [open testOpenFileChannel3%.fil r]
 	} err3
 
 	file delete __testOpenFileChannel1%__.fil
 	file delete __testOpenFileChannel3%__.fil
 
-    set err3
-} {}
+    list $err3 $msg1
+} [list {} {couldn't open "testOpenFileChannel2%.fil": no such file or directory}]
 
 test ioUtil-3.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {
     # Next delete the 1st procedure and test that only the 3rd procedure
@@ -266,15 +266,16 @@ test ioUtil-3.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel
 	close [open __testOpenFileChannel3%__.fil w]
 
 	catch {
-		catch {close [open testOpenFileChannel1%.fil r]}
-		catch {close [open testOpenFileChannel2%.fil r]}
+		catch {close [open testOpenFileChannel1%.fil r]} msg2
+		catch {close [open testOpenFileChannel2%.fil r]} msg3
 		close [open testOpenFileChannel3%.fil r]
 	} err4
 
 	file delete __testOpenFileChannel3%__.fil
 
-    set err4
-} {}
+    list $err4 $msg2 $msg3
+} [list {} {couldn't open "testOpenFileChannel1%.fil": no such file or directory} \
+	{couldn't open "testOpenFileChannel2%.fil": no such file or directory}]
 
 test ioUtil-3.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} {
     # Finally delete the 3rd procedure and check that none of the
@@ -282,13 +283,15 @@ test ioUtil-3.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify
 
     testopenfilechannelproc delete TestOpenFileChannelProc3
 	catch {
-		catch [open testOpenFileChannel1%.fil r]
-		catch [open testOpenFileChannel2%.fil r]
-		catch [open testOpenFileChannel3%.fil r]
+		catch {close [open testOpenFileChannel1%.fil r]} msg4
+		catch {close [open testOpenFileChannel2%.fil r]} msg5
+		catch {close [open testOpenFileChannel3%.fil r]} msg6
 	} err5
 
-    set err5
-} {1}
+    list $err5 $msg4 $msg5 $msg6
+} [list 1 {couldn't open "testOpenFileChannel1%.fil": no such file or directory} \
+	{couldn't open "testOpenFileChannel2%.fil": no such file or directory} \
+	{couldn't open "testOpenFileChannel3%.fil": no such file or directory}]
 
 test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} {
     # Attempt to delete all the OpenFileChannel procs. again to ensure they no longer
diff --git a/tests/pkg.test b/tests/pkg.test
index 9618ed8..0588ab0 100644
--- a/tests/pkg.test
+++ b/tests/pkg.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: pkg.test,v 1.8 2000/04/10 17:19:03 ericm Exp $
+# RCS: @(#) $Id: pkg.test,v 1.8.2.1 2001/08/24 16:19:10 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -301,6 +301,14 @@ test pkg-3.5 {Tcl_PackageCmd procedure, "forget" option} {
     package forget a c
     lappend result [lsort [package names]]
 } {{a b c} b}
+test pkg-3.5.1 {Tcl_PackageCmd procedure, "forget" option} {
+    # Test for Bug 415273
+    package ifneeded a 1 "I should have been forgotten"
+    package forget no-such-package a
+    set x [package ifneeded a 1]
+    package forget a
+    set x
+} {}
 test pkg-3.6 {Tcl_PackageCmd procedure, "ifneeded" option} {
     list [catch {package ifneeded a} msg] $msg
 } {1 {wrong # args: should be "package ifneeded package version ?script?"}}
diff --git a/tests/unixInit.test b/tests/unixInit.test
index 1ae5407..3f583b6 100644
--- a/tests/unixInit.test
+++ b/tests/unixInit.test
@@ -10,13 +10,15 @@
 # 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.13.2.1 2001/04/03 22:54:38 hobbs Exp $
+# RCS: @(#) $Id: unixInit.test,v 1.13.2.2 2001/08/24 16:19:10 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+set ::tcltest::testConstraints(notInstalledInTmp) \
+	[string match /tmp/lib/* [info library]]
 if {[info exists env(TCL_LIBRARY)]} {
     set oldlibrary $env(TCL_LIBRARY)
     unset env(TCL_LIBRARY)
@@ -27,10 +29,10 @@ set env(LANG) C
 # Some tests will fail if they are run on a machine that doesn't have
 # this Tcl version installed (as opposed to built) on it.
 if {[catch {
-    set f [open "|[list $::tcltest::tcltest exit]" w+]
+    set f [open "|[list $::tcltest::tcltest]" w+]
     exec kill -PIPE [pid $f]
     close $f
-}]} {
+} msg]} {
     set ::tcltest::testConstraints(installedTcl) 0
 } else {
     set ::tcltest::testConstraints(installedTcl) 1
@@ -150,24 +152,75 @@ test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} \
     # would need test command to get defaultLibDir and compare it to
     # [lindex $auto_path end]
 } {}
-test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unixOnly} {
+test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unixOnly notInstalledInTmp} {
+    # Checking for Bug 219416
+    # When a program that embeds the Tcl library, like tcltest, is
+    # installed near the "root" of the file system, there was a problem
+    # constructing directories relative to the executable.  When a 
+    # relative ".." went past the root, relative path names were created
+    # rather than absolute pathnames.  In some cases, accessing past the
+    # root caused memory access violations too.
+    #
+    # The bug is now fixed, but here we check for it by making sure that
+    # the directories constructed relative to the executable are all
+    # absolute pathnames, even when the executable is installed near
+    # the root of the filesystem.
+    #
+    # The only directory near the root we are likely to have write access
+    # to is /tmp.
     file delete -force /tmp/sparkly
-    file delete -force /tmp/lib
+    file delete -force /tmp/lib/tcl[info tclversion]
     file mkdir /tmp/sparkly
     file copy $::tcltest::tcltest /tmp/sparkly/tcltest
 
+    # Keep any existing /tmp/lib directory
+    set deletelib 1
+    if {[file exists /tmp/lib]} {
+	if {[file isdirectory /tmp/lib]} {
+	    set deletelib 0
+	} else {
+	    file delete -force /tmp/lib
+	}
+    }
+
+    # For a successful Tcl_Init, we need a [source]-able init.tcl in
+    # ../lib/tcl$version relative to the executable.
     file mkdir /tmp/lib/tcl[info tclversion]
     close [open /tmp/lib/tcl[info tclversion]/init.tcl w]
 
+    # Check that all directories in the library path are absolute pathnames
     set allAbsolute 1
     foreach dir [getlibpath /tmp/sparkly/tcltest] {
 	set allAbsolute [expr {$allAbsolute \
 		&& [string equal absolute [file pathtype $dir]]}]
     }
+
+    # Clean up temporary installation
     file delete -force /tmp/sparkly
-    file delete -force /tmp/lib
+    file delete -force /tmp/lib/tcl[info tclversion]
+    if {$deletelib} {file delete -force /tmp/lib}
     set allAbsolute
 } 1
+test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} {
+	unixOnly} {
+    # Checking for Bug 438014
+    file delete -force /tmp/sparkly
+    file delete -force /tmp/library
+    file mkdir /tmp/sparkly
+    file copy $::tcltest::tcltest /tmp/sparkly/tcltest
+
+    file mkdir /tmp/library/
+    close [open /tmp/library/init.tcl w]
+
+    set x [lrange [getlibpath /tmp/sparkly/tcltest] 0 4]
+
+    file delete -force /tmp/sparkly
+    file delete -force /tmp/library
+    set x
+} [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \
+	/tmp/library /library [format /tcl%s/library \
+	[expr {[regexp {[ab]} [info patchlevel]] ? 
+	[info patchleve] : [info tclversion]}]]]
 test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} {
     set env(LANG) C
 
@@ -215,7 +268,7 @@ test unixInit-5.1 {Tcl_Init} {emptyTest unixOnly} {
 
 test unixInit-6.1 {Tcl_SourceRCFile} {emptyTest unixOnly} {
 } {}
-    
+
 # cleanup
 if {[info exists oldlibrary]} {
     set env(TCL_LIBRARY) $oldlibrary
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index d131e28..9166c20 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -8,7 +8,9 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: genStubs.tcl,v 1.7 1999/06/10 04:29:01 stanton Exp $
+# RCS: @(#) $Id: genStubs.tcl,v 1.7.10.1 2001/08/24 16:19:10 dgp Exp $
+
+package require Tcl 8
 
 namespace eval genStubs {
     # libraryName --
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 35d8cc3..956c058 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -7,7 +7,7 @@
  * Copyright (c) 1999 by Scriptics Corporation.
  * All rights reserved.
  *
- * RCS: @(#) $Id: tclUnixInit.c,v 1.18.2.2 2001/04/03 22:54:39 hobbs Exp $
+ * RCS: @(#) $Id: tclUnixInit.c,v 1.18.2.3 2001/08/24 16:19:10 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -290,43 +290,55 @@ CONST char *path;		/* Path to the executable in native
     if (path != NULL) {
 	Tcl_SplitPath(path, &pathc, &pathv);
 	if (pathc > 2) {
+	    str = pathv[pathc - 2];
 	    pathv[pathc - 2] = installLib;
 	    path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+	    pathv[pathc - 2] = str;
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
 	if (pathc > 3) {
+	    str = pathv[pathc - 3];
 	    pathv[pathc - 3] = installLib;
 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+	    pathv[pathc - 3] = str;
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
 	if (pathc > 2) {
+	    str = pathv[pathc - 2];
 	    pathv[pathc - 2] = "library";
 	    path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+	    pathv[pathc - 2] = str;
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
 	if (pathc > 3) {
+	    str = pathv[pathc - 3];
 	    pathv[pathc - 3] = "library";
 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+	    pathv[pathc - 3] = str;
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
 	if (pathc > 3) {
+	    str = pathv[pathc - 3];
 	    pathv[pathc - 3] = developLib;
 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+	    pathv[pathc - 3] = str;
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
 	if (pathc > 4) {
+	    str = pathv[pathc - 4];
 	    pathv[pathc - 4] = developLib;
 	    path = Tcl_JoinPath(pathc - 3, pathv, &ds);
+	    pathv[pathc - 4] = str;
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 2d22b0a..8328bb9 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -7,7 +7,7 @@
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  * All rights reserved.
  *
- * RCS: @(#) $Id: tclWinInit.c,v 1.22.2.1 2001/04/03 22:54:39 hobbs Exp $
+ * RCS: @(#) $Id: tclWinInit.c,v 1.22.2.2 2001/08/24 16:19:10 dgp Exp $
  */
 
 #include "tclWinInt.h"
@@ -249,43 +249,55 @@ TclpInitLibraryPath(path)
     if (path != NULL) {
 	Tcl_SplitPath(path, &pathc, &pathv);
 	if (pathc > 2) {
+	    str = pathv[pathc - 2];
 	    pathv[pathc - 2] = installLib;
 	    path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+	    pathv[pathc - 2] = str;
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
 	if (pathc > 3) {
+	    str = pathv[pathc - 3];
 	    pathv[pathc - 3] = installLib;
 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+	    pathv[pathc - 3] = str;
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
 	if (pathc > 2) {
+	    str = pathv[pathc - 2];
 	    pathv[pathc - 2] = "library";
 	    path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+	    pathv[pathc - 2] = str;
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
 	if (pathc > 3) {
+	    str = pathv[pathc - 3];
 	    pathv[pathc - 3] = "library";
 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+	    pathv[pathc - 3] = str;
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
 	if (pathc > 3) {
+	    str = pathv[pathc - 3];
 	    pathv[pathc - 3] = developLib;
 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+	    pathv[pathc - 3] = str;
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
 	if (pathc > 4) {
+	    str = pathv[pathc - 4];
 	    pathv[pathc - 4] = developLib;
 	    path = Tcl_JoinPath(pathc - 3, pathv, &ds);
+	    pathv[pathc - 4] = str;
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);