diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclFileName.c | 24 | ||||
| -rw-r--r-- | tests/fileName.test | 9 | ||||
| -rw-r--r-- | win/tclWinPipe.c | 49 |
4 files changed, 49 insertions, 42 deletions
@@ -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; } |