2001-01-04 Don Porter <dgp@users.sourceforge.net>

	* tests/unixInit.test:
	* unix/tclUnixInit.c (TclpInitLibraryPath):
	* win/tclWinInit.c (TclpInitLibraryPath):  Several entries in
	the library path ($tcl_libPath) are determined relative to the
	absolute path of the executable.  When the executable is
	installed in or near the root directory of the file system,
	relative pathnames were being incorrectly generated, and in
	the worst case, memory access violations were crashing the program.
	[Bug 119416, Patch 102972]

4 files changed, 55 insertions, 16 deletions

diff --git a/ChangeLog b/ChangeLog
index 3f7b39a..8f71ca8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
-2000-12-14  Don Porter  <dgp@users.sourceforge.net>
+2001-01-04  Don Porter  <dgp@users.sourceforge.net>
+	* tests/unixInit.test:
+	* unix/tclUnixInit.c (TclpInitLibraryPath):
+	* win/tclWinInit.c (TclpInitLibraryPath):  Several entries in
+	the library path ($tcl_libPath) are determined relative to the
+	absolute path of the executable.  When the executable is
+	installed in or near the root directory of the file system,
+	relative pathnames were being incorrectly generated, and in
+	the worst case, memory access violations were crashing the program.
+	[Bug 119416, Patch 102972]
 
+2000-12-14  Don Porter  <dgp@users.sourceforge.net>
 	* generic/tclExecute.c:
 	* tests/expr-old.test:  Re-wrote Tcl's [expr rand()] and
 	[expr srand($seed)] implementations, fixing a range error
diff --git a/tests/unixInit.test b/tests/unixInit.test
index 746114c..3017587 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.13 2000/04/10 17:19:05 ericm Exp $
+# RCS: @(#) $Id: unixInit.test,v 1.14 2001/01/04 21:30:49 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -150,6 +150,24 @@ 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} {
+    file delete -force /tmp/sparkly
+    file delete -force /tmp/lib
+    file mkdir /tmp/sparkly
+    file copy $::tcltest::tcltest /tmp/sparkly/tcltest
+
+    file mkdir /tmp/lib/tcl[info tclversion]
+    close [open /tmp/lib/tcl[info tclversion]/init.tcl w]
+
+    set allAbsolute 1
+    foreach dir [getlibpath /tmp/sparkly/tcltest] {
+	set allAbsolute [expr {$allAbsolute \
+		&& [string equal absolute [file pathtype $dir]]}]
+    }
+    file delete -force /tmp/sparkly
+    file delete -force /tmp/lib
+    set allAbsolute
+} 1
 test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} {
     set env(LANG) C
 
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index dcff38b..aaaa811 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.20 2000/10/31 00:48:53 hobbs Exp $
+ * RCS: @(#) $Id: tclUnixInit.c,v 1.21 2001/01/04 21:30:49 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -281,44 +281,50 @@ CONST char *path;		/* Path to the executable in native
      *		(e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../../tcl8.2/library)
      */
      
+
+     /*
+      * The variable path holds an absolute path.  Take care not to
+      * overwrite pathv[0] since that might produce a relative path.
+      */
+
     if (path != NULL) {
 	Tcl_SplitPath(path, &pathc, &pathv);
-	if (pathc > 1) {
+	if (pathc > 2) {
 	    pathv[pathc - 2] = installLib;
 	    path = Tcl_JoinPath(pathc - 1, pathv, &ds);
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
-	if (pathc > 2) {
+	if (pathc > 3) {
 	    pathv[pathc - 3] = installLib;
 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
-	if (pathc > 1) {
+	if (pathc > 2) {
 	    pathv[pathc - 2] = "library";
 	    path = Tcl_JoinPath(pathc - 1, pathv, &ds);
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
-	if (pathc > 2) {
+	if (pathc > 3) {
 	    pathv[pathc - 3] = "library";
 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
-	if (pathc > 1) {
+	if (pathc > 3) {
 	    pathv[pathc - 3] = developLib;
 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
-	if (pathc > 3) {
+	if (pathc > 4) {
 	    pathv[pathc - 4] = developLib;
 	    path = Tcl_JoinPath(pathc - 3, pathv, &ds);
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 1f6d76f..125afcc 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.24 2000/07/26 01:27:58 davidg Exp $
+ * RCS: @(#) $Id: tclWinInit.c,v 1.25 2001/01/04 21:30:49 dgp Exp $
  */
 
 #include "tclWinInt.h"
@@ -229,44 +229,49 @@ TclpInitLibraryPath(path)
      *		(e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../../tcl8.2/library)
      */
      
+    /*
+     * The variable path holds an absolute path.  Take care not to
+     * overwrite pathv[0] since that might produce a relative path.
+     */
+
     if (path != NULL) {
 	Tcl_SplitPath(path, &pathc, &pathv);
-	if (pathc > 1) {
+	if (pathc > 2) {
 	    pathv[pathc - 2] = installLib;
 	    path = Tcl_JoinPath(pathc - 1, pathv, &ds);
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
-	if (pathc > 2) {
+	if (pathc > 3) {
 	    pathv[pathc - 3] = installLib;
 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
-	if (pathc > 1) {
+	if (pathc > 2) {
 	    pathv[pathc - 2] = "library";
 	    path = Tcl_JoinPath(pathc - 1, pathv, &ds);
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
-	if (pathc > 2) {
+	if (pathc > 3) {
 	    pathv[pathc - 3] = "library";
 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
-	if (pathc > 1) {
+	if (pathc > 3) {
 	    pathv[pathc - 3] = developLib;
 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
 	    Tcl_DStringFree(&ds);
 	}
-	if (pathc > 3) {
+	if (pathc > 4) {
 	    pathv[pathc - 4] = developLib;
 	    path = Tcl_JoinPath(pathc - 3, pathv, &ds);
 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));