filesystem bug fixes: volumerelative normalization, file join inconsistency

4 files changed, 85 insertions, 37 deletions

diff --git a/ChangeLog b/ChangeLog
index 71beb68..460690c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2003-10-06  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* generic/tclFileName.c:
+	* generic/tclIOUtil.c: backport of volumerelative file normalization
+	and 'file join' inconsistency fixes [Bug 767834, 813273].
+
 2003-10-04  Chengye Mao <chengye.geo@yahoo.com>
 
 	* win/tclWinPipe.c: fixed a bug in BuildCommandLine.
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index be689af..6d7a41c 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.4 2003/10/03 17:45:37 vincentdarley Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.40.2.5 2003/10/06 09:49:19 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -1392,7 +1392,8 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
     Tcl_DStringInit(bufferPtr);
     Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1);
     Tcl_DecrRefCount(path);
-
+    Tcl_DecrRefCount(transPtr);
+    
     /*
      * Convert forward slashes to backslashes in Windows paths because
      * some system interfaces don't accept forward slashes.
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index c59348a..8de62f1 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.9 2003/10/03 17:45:37 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.10 2003/10/06 09:49:20 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -4515,25 +4515,34 @@ Tcl_FSJoinPath(listObj, elements)
 	}
     }
     
-    if (elements == 2) {
-	/* 
-	 * This is a special case where we can be much more
-	 * efficient
-	 */
-	Tcl_Obj *base;
+    res = Tcl_NewObj();
+    
+    for (i = 0; i < elements; i++) {
+	Tcl_Obj *elt;
+	int driveNameLength;
+	Tcl_PathType type;
+	char *strElt;
+	int strEltLen;
+	int length;
+	char *ptr;
+	Tcl_Obj *driveName = NULL;
+	
+	Tcl_ListObjIndex(NULL, listObj, i, &elt);
 	
-	Tcl_ListObjIndex(NULL, listObj, 0, &base);
 	/* 
-	 * There is only any value in doing this if the first object is
-	 * of path type, otherwise we'll never actually get any
-	 * efficiency benefit elsewhere in the code (from re-using the
-	 * normalized representation of the base object).
+	 * This is a special case where we can be much more
+	 * efficient, where we are joining a single relative path
+	 * onto an object that is already of path type.  The 
+	 * 'TclNewFSPathObj' call below creates an object which
+	 * can be normalized more efficiently.  Currently we only
+	 * use the special case when we have exactly two elements,
+	 * but we could expand that in the future.
 	 */
-	if (base->typePtr == &tclFsPathType
-		&& !(base->bytes != NULL && base->bytes[0] == '\0')) {
+	if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType)
+	  && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) {
 	    Tcl_Obj *tail;
 	    Tcl_PathType type;
-	    Tcl_ListObjIndex(NULL, listObj, 1, &tail);
+	    Tcl_ListObjIndex(NULL, listObj, i+1, &tail);
 	    type = GetPathType(tail, NULL, NULL, NULL);
 	    if (type == TCL_PATH_RELATIVE) {
 		CONST char *str;
@@ -4545,10 +4554,22 @@ Tcl_FSJoinPath(listObj, elements)
 		     * '/'.  There's no need to return a special path
 		     * object, when the base itself is just fine!
 		     */
-		    return base;
+		    Tcl_DecrRefCount(res);
+		    return elt;
 		}
-		if (str[0] != '.') {
-		    return TclNewFSPathObj(base, str, len);
+		/* 
+		 * If it doesn't begin with '.'  and is a mac or unix
+		 * path or it a windows path without backslashes, then we
+		 * can be very efficient here.  (In fact even a windows
+		 * path with backslashes can be joined efficiently, but
+		 * the path object would not have forward slashes only,
+		 * and this would therefore contradict our 'file join'
+		 * documentation).
+		 */
+		if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) 
+				      || (strchr(str, '\\') == NULL))) {
+		    Tcl_DecrRefCount(res);
+		    return TclNewFSPathObj(elt, str, len);
 		}
 		/* 
 		 * Otherwise we don't have an easy join, and
@@ -4556,24 +4577,27 @@ Tcl_FSJoinPath(listObj, elements)
 		 * things
 		 */
 	    } else {
-		return tail;
+		if (tclPlatform == TCL_PLATFORM_UNIX) {
+		    Tcl_DecrRefCount(res);
+		    return tail;
+		} else {
+		    CONST char *str;
+		    int len;
+		    str = Tcl_GetStringFromObj(tail,&len);
+		    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
+			if (strchr(str, '\\') == NULL) {
+			    Tcl_DecrRefCount(res);
+			    return tail;
+			}
+		    } else if (tclPlatform == TCL_PLATFORM_MAC) {
+			if (strchr(str, '/') == NULL) {
+			    Tcl_DecrRefCount(res);
+			    return tail;
+			}
+		    }
+		}
 	    }
 	}
-    }
-    
-    res = Tcl_NewObj();
-    
-    for (i = 0; i < elements; i++) {
-	Tcl_Obj *elt;
-	int driveNameLength;
-	Tcl_PathType type;
-	char *strElt;
-	int strEltLen;
-	int length;
-	char *ptr;
-	Tcl_Obj *driveName = NULL;
-	
-	Tcl_ListObjIndex(NULL, listObj, i, &elt);
 	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
 	type = GetPathType(elt, &fsPtr, &driveNameLength, &driveName);
 	if (type != TCL_PATH_RELATIVE) {
diff --git a/tests/fileName.test b/tests/fileName.test
index e858caa..830618b 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.2 2003/10/03 17:25:22 vincentdarley Exp $
+# RCS: @(#) $Id: fileName.test,v 1.30.2.3 2003/10/06 09:49:20 vincentdarley Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -903,6 +903,23 @@ test filename-9.19 {Tcl_JoinPath: win} {testsetplatform} {
       [file join C:/blah {C:\foo\bar}] \
       [file join C:/blah C:/blah {C:\foo\bar}]
 } {C:/foo/bar C:/foo/bar C:/foo/bar}
+test filename-9.19.1 {Tcl_JoinPath: win} {testsetplatform} {
+    testsetplatform win
+    set res {}
+    lappend res \
+      [file join {foo\bar}] \
+      [file join C:/blah {foo\bar}] \
+      [file join C:/blah C:/blah {foo\bar}]
+} {foo/bar C:/blah/foo/bar C:/blah/foo/bar}
+test filename-9.19.2 {Tcl_JoinPath: win} {testsetplatform winOnly} {
+    testsetplatform win
+    set res {}
+    lappend res \
+      [file join {foo\bar}] \
+      [file join [pwd] {foo\bar}] \
+      [file join [pwd] [pwd] {foo\bar}]
+    string map [list [pwd] pwd] $res
+} {foo/bar pwd/foo/bar pwd/foo/bar}
 test filename-9.20 {Tcl_JoinPath: unix} {testsetplatform} {
     testsetplatform unix
     set res {}