bugs 1194458 and 1225044

4 files changed, 49 insertions, 42 deletions

diff --git a/ChangeLog b/ChangeLog
index f4e887b..0285404 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2005-06-21  Kevin Kenny  <kennykb@acm.org>
+
+	* generic/tclFileName.c: Corrected a problem where a directory name
+	containing a colon can crash the process on Windows [Bug 1194458].
+	* tests/fileName.test: Added test for [file split] and
+	[file join] with a name containing a colon.
+	* win/tclWinPipe.c: Reverted davygrvy's changes of 2005-04-19;
+	they cause multiple failures in io.test.  [Bug 1225044, still open].
+	
 2005-06-21  Don Porter  <dgp@users.sourceforge.net>
 
 	*** 8.4.11 TAGGED FOR RELEASE ***
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 67d606d..eb59182 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.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: tclFileName.c,v 1.40.2.10 2005/03/15 22:10:58 vincentdarley Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.40.2.11 2005/06/21 19:07:41 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -792,8 +792,9 @@ SplitWinPath(path)
     Tcl_DStringFree(&buf);
     
     /*
-     * Split on slashes.  Embedded elements that start with tilde will be
-     * prefixed with "./" so they are not affected by tilde substitution.
+     * Split on slashes.  Embedded elements that start with tilde 
+     * or a drive letter will be prefixed with "./" so they are not 
+     * affected by tilde substitution.
      */
 
     do {
@@ -804,7 +805,10 @@ SplitWinPath(path)
 	length = p - elementStart;
 	if (length > 0) {
 	    Tcl_Obj *nextElt;
-	    if ((elementStart[0] == '~') && (elementStart != path)) {
+	    if ((elementStart != path)
+		&& ((elementStart[0] == '~')
+		    || (isalpha(UCHAR(elementStart[0]))
+			&& elementStart[1] == ':'))) {
 		nextElt = Tcl_NewStringObj("./",2);
 		Tcl_AppendToObj(nextElt, elementStart, length);
 	    } else {
@@ -1125,23 +1129,25 @@ TclpNativeJoinPath(prefix, joining)
     start = Tcl_GetStringFromObj(prefix, &length);
 
     /*
-     * Remove the ./ from tilde prefixed elements unless
-     * it is the first component.
+     * Remove the ./ from tilde prefixed elements, and drive-letter
+     * prefixed elements on Windows, unless it is the first component.
      */
     
     p = joining;
     
     if (length != 0) {
-	if ((p[0] == '.') && (p[1] == '/') && (p[2] == '~')) {
+	if ((p[0] == '.') && (p[1] == '/')
+	    && ((p[2] == '~')
+		|| ((tclPlatform == TCL_PLATFORM_WINDOWS)
+		    && isalpha(UCHAR(p[2]))
+		    && (p[3] == ':')))) {
 	    p += 2;
 	}
     }
-       
     if (*p == '\0') {
 	return;
     }
 
-
     switch (tclPlatform) {
         case TCL_PLATFORM_UNIX:
 	    /*
diff --git a/tests/fileName.test b/tests/fileName.test
index d0497de..7635e2d 100644
--- a/tests/fileName.test
+++ b/tests/fileName.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: fileName.test,v 1.30.2.6 2004/11/11 01:16:19 das Exp $
+# RCS: @(#) $Id: fileName.test,v 1.30.2.7 2005/06/21 19:07:58 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -2001,6 +2001,13 @@ test filename-17.2 {windows specific glob with executable} {winOnly} {
     set res
 } {abc.exe}
 
+test fileName-18.1 {windows - split ADS name correctly} {winOnly} {
+    # bug 1194458
+    set x [file split c:/c:d]
+    set y [eval [linsert $x 0 file join]]
+    list $x $y
+} {{c:/ ./c:d} c:/c:d}
+
 # cleanup
 catch {file delete -force C:/globTest}
 cd [temporaryDirectory]
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 0206ac5..8dfc2ad 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.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: tclWinPipe.c,v 1.33.2.10 2005/04/19 16:28:22 davygrvy Exp $
+ * RCS: @(#) $Id: tclWinPipe.c,v 1.33.2.11 2005/06/21 19:07:58 kennykb Exp $
  */
 
 #include "tclWinInt.h"
@@ -2046,42 +2046,27 @@ PipeClose2Proc(
 	}
     }
 
-    if ((pipePtr->flags & PIPE_ASYNC) || TclInExit()) {
-	/*
-	 * If the channel is non-blocking or Tcl is being cleaned up,
-	 * just detach the children PIDs, reap them (important if we are
-	 * in a dynamic load module), and discard the errorFile.
-	 */
+    /*
+     * Wrap the error file into a channel and give it to the cleanup
+     * routine.
+     */
 
-	Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr);
-	Tcl_ReapDetachedProcs();
+    if (pipePtr->errorFile) {
+	WinFile *filePtr;
 
-	if (pipePtr->errorFile) {
-	    TclpCloseFile(pipePtr->errorFile);
-	}
+	filePtr = (WinFile*)pipePtr->errorFile;
+	errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
+		TCL_READABLE);
+	ckfree((char *) filePtr);
     } else {
-	/*
-	 * Wrap the error file into a channel and give it to the cleanup
-	 * routine.
-	 */
-
-	if (pipePtr->errorFile) {
-	    WinFile *filePtr;
-
-	    filePtr = (WinFile*)pipePtr->errorFile;
-	    errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
-		    TCL_READABLE);
-	    ckfree((char *) filePtr);
-	} else {
-	    errChan = NULL;
-	}
-
-	result = TclCleanupChildren(interp, pipePtr->numPids,
-		pipePtr->pidPtr, errChan);
+        errChan = NULL;
     }
 
+    result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
+            errChan);
+
     if (pipePtr->numPids > 0) {
-	ckfree((char *) pipePtr->pidPtr);
+        ckfree((char *) pipePtr->pidPtr);
     }
 
     if (pipePtr->writeBuf != NULL) {
@@ -2091,7 +2076,7 @@ PipeClose2Proc(
     ckfree((char*) pipePtr);
 
     if (errorCode == 0) {
-	return result;
+        return result;
     }
     return errorCode;
 }