* generic/tclIOUtil.c (Tcl_FSChdir): Work-around crash condition

	* tests/winFCmd.test (winFCmd-16.12): triggered when $HOME is
	volumerelative (ie 'C:').

3 files changed, 69 insertions, 9 deletions

diff --git a/ChangeLog b/ChangeLog
index 7632d76..a2d3791 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 2004-05-04  Jeff Hobbs  <jeffh@ActiveState.com>
 
+	* generic/tclIOUtil.c (Tcl_FSChdir):  Work-around crash condition
+	* tests/winFCmd.test (winFCmd-16.12): triggered when $HOME is
+	volumerelative (ie 'C:').
+
 	* tests/fileName.test (filename-12.9): use C:/ instead of the
 	first item in file volumes - that's usually A:/, which for most
 	will have nothing in it.
@@ -15,16 +19,16 @@
 	  TtySetOptionProc. Report and Patch provided by Stuart
 	  Cassoff <stwo@users.sf.net>.
 
-2004-05-03  Kevin Kenny  <kennykb@acm.org>
+2004-05-03  Kevin Kenny	 <kennykb@acm.org>
 
 	* win/tclWin32Dll.c (TclpCheckStackSpace):
 	* tests/stack.test (stack-3.1): Fix for undetected stack
 	overflow in TclReExec on Windows. [Bug 947070]
-	
-2004-05-03  Don Porter  <dgp@users.sourceforge.net>
 
-        * library/init.tcl:     Corrected unique prefix matching of
-        interactive command completion in [unknown].  [Bug 946952]
+2004-05-03  Don Porter	<dgp@users.sourceforge.net>
+
+	* library/init.tcl:	Corrected unique prefix matching of
+	interactive command completion in [unknown].  [Bug 946952]
 
 2004-05-02  Miguel Sofer <msofer@users.sf.net>
 
@@ -57,8 +61,8 @@
 
 2004-04-02  Don Porter  <dgp@users.sourceforge.net>
 
-        * tests/tcltest.test: Corrected constraint typos: "nonRoot" ->
-        "notRoot".  Thanks to Steven Abner (tauvan). [Bug 928353]
+	* tests/tcltest.test: Corrected constraint typos: "nonRoot" ->
+	"notRoot".  Thanks to Steven Abner (tauvan). [Bug 928353]
 
 2004-03-31  Don Porter	<dgp@users.sourceforge.net>
 
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index f91a2b6..046039e 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.16 2004/02/18 01:59:09 hobbs Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.17 2004/05/04 22:26:00 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -2602,7 +2602,48 @@ Tcl_FSChdir(pathPtr)
     Tcl_Filesystem *fsPtr;
     int retVal = -1;
     
+#ifdef WIN32
+    /*
+     * This complete hack addresses the bug tested in winFCmd-16.12,
+     * where having your HOME as "C:" (IOW, a seemingly path relative
+     * dir) would cause a crash when you cd'd to it and requested 'pwd'.
+     * The work-around is to force such a dir into an absolute path by
+     * tacking on '/'.
+     *
+     * We check for '~' specifically because that's what Tcl_CdObjCmd
+     * passes in that triggers the bug.  A direct 'cd C:' call will not
+     * because that gets the volumerelative pwd.
+     *
+     * This is not an issue for 8.5 as that has a more elaborate change
+     * that requires the use of TCL_FILESYSTEM_VERSION_2.
+     */
+    Tcl_Obj *objPtr = NULL;
+    if (pathPtr->bytes && pathPtr->length == 1 && pathPtr->bytes[0] == '~') {
+	int len;
+	char *str;
+
+	objPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+	if (objPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_IncrRefCount(objPtr);
+	str = Tcl_GetStringFromObj(objPtr, &len);
+	if (len == 2 && str[1] == ':') {
+	    pathPtr = Tcl_NewStringObj(str, len);
+	    Tcl_AppendToObj(pathPtr, "/", 1);
+	    Tcl_IncrRefCount(pathPtr);
+	    Tcl_DecrRefCount(objPtr);
+	    objPtr = pathPtr;
+	} else {
+	    Tcl_DecrRefCount(objPtr);
+	    objPtr = NULL;
+	}
+    }
+#endif
     if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
+#ifdef WIN32
+	if (objPtr) { Tcl_DecrRefCount(objPtr); }
+#endif
         return TCL_ERROR;
     }
     
@@ -2646,6 +2687,9 @@ Tcl_FSChdir(pathPtr)
 	     */
 	    Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
 	    if (normDirName == NULL) {
+#ifdef WIN32
+		if (objPtr) { Tcl_DecrRefCount(objPtr); }
+#endif
 	        return TCL_ERROR;
 	    }
 	    FsUpdateCwd(normDirName);
@@ -2654,6 +2698,9 @@ Tcl_FSChdir(pathPtr)
 	Tcl_SetErrno(ENOENT);
     }
     
+#ifdef WIN32
+    if (objPtr) { Tcl_DecrRefCount(objPtr); }
+#endif
     return (retVal);
 }
 
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 78d85c9..0b1fdf0 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.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: winFCmd.test,v 1.20.2.3 2003/11/21 16:19:15 dgp Exp $
+# RCS: @(#) $Id: winFCmd.test,v 1.20.2.4 2004/05/04 22:26:00 hobbs Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -1014,6 +1014,15 @@ test winFCmd-16.11 {Windows file normalization} {pcOnly cdrom} {
     # Must not crash
     set result "no crash"
 } {no crash}
+test winFCmd-16.12 {Windows file normalization} {pcOnly} {
+    set oldhome ""
+    catch {set oldhome $::env(HOME)}
+    set ::env(HOME) ${d}:
+    cd
+    set result [pwd]; # <- Must not crash
+    set ::env(HOME) $oldhome
+    set result
+} ${d}:/
 
 cd $pwd
 unset d dd pwd