bug 1194458

3 files changed, 31 insertions, 9 deletions

diff --git a/ChangeLog b/ChangeLog
index 5b7b8da..2c17918d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2005-06-21  Kevin B. Kenny  <kennykb@acm.org>
+
+	* generic/tclFileName.c: Changed [file split] and [file join]
+	to treat Windows drive letters similarly to ~ syntax and make
+	sure that they appear with "./" in front when they are in
+	intermediate components of the path. [Bug 1194458]
+	* tests/fileName.test: Added test for the above bug.
+	
 2005-06-21  Don Porter  <dgp@users.sourceforge.net>
 
         * generic/tclBasic.c:   Added missing walk of the list of active traces
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 5bfad99..900f121 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.69 2005/05/10 18:34:38 kennykb Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.70 2005/06/21 19:20:11 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -629,8 +629,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 {
@@ -641,7 +642,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 {
@@ -738,18 +742,21 @@ 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;
     }
diff --git a/tests/fileName.test b/tests/fileName.test
index 1e50b01..09b7ee1 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.45 2004/11/11 01:16:05 das Exp $
+# RCS: @(#) $Id: fileName.test,v 1.46 2005/06/21 19:20:12 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -1519,6 +1519,13 @@ test filename-17.2 {windows specific glob with executable} {win} {
     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]