backporting of filesystem tests, docs

8 files changed, 155 insertions, 37 deletions

diff --git a/ChangeLog b/ChangeLog
index eed0f6b..b435ddc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2003-10-03  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* tests/fileName.test:
+	* tests/winFCmd.test:
+        * doc/FileSystem.3: backported various test and documentation
+        changes from HEAD.  Backport of actual code fixes to follow.
+
 2003-10-02  Don Porter  <dgp@users.sourceforge.net>
 
 	* README:		Bumped patch level to 8.4.5 to prepare
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index ea7ee05..be689af 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.3 2003/07/17 00:16:04 hobbs Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.40.2.4 2003/10/03 17:45:37 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -1380,16 +1380,17 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
 				 * with name after tilde substitution. */
 {
     Tcl_Obj *path = Tcl_NewStringObj(name, -1);
-    CONST char *result;
+    Tcl_Obj *transPtr;
 
     Tcl_IncrRefCount(path);
-    result = Tcl_FSGetTranslatedStringPath(interp, path);
-    if (result == NULL) {
+    transPtr = Tcl_FSGetTranslatedPath(interp, path);
+    if (transPtr == NULL) {
 	Tcl_DecrRefCount(path);
 	return NULL;
     }
+    
     Tcl_DStringInit(bufferPtr);
-    Tcl_DStringAppend(bufferPtr, result, -1);
+    Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1);
     Tcl_DecrRefCount(path);
 
     /*
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index bfe08b4..c59348a 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.8 2003/09/01 12:30:38 vasiljevic Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.9 2003/10/03 17:45:37 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -1810,6 +1810,9 @@ Tcl_FSStat(pathPtr, buf)
 	    retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer);
 	    statProcPtr = statProcPtr->nextPtr;
 	}
+	if (transPtr != NULL) {
+	    Tcl_DecrRefCount(transPtr);
+	}
     }
     
     Tcl_MutexUnlock(&obsoleteFsHookMutex);
@@ -1937,6 +1940,9 @@ Tcl_FSAccess(pathPtr, mode)
 	    retVal = (*accessProcPtr->proc)(path, mode);
 	    accessProcPtr = accessProcPtr->nextPtr;
 	}
+	if (transPtr != NULL) {
+	    Tcl_DecrRefCount(transPtr);
+	}
     }
     
     Tcl_MutexUnlock(&obsoleteFsHookMutex);
@@ -2014,6 +2020,9 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
 						     modeString, permissions);
 	    openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
 	}
+	if (transPtr != NULL) {
+	    Tcl_DecrRefCount(transPtr);
+	}
     }
     Tcl_MutexUnlock(&obsoleteFsHookMutex);
     if (retVal != NULL) {
@@ -5093,6 +5102,7 @@ Tcl_FSGetTranslatedPath(interp, pathPtr)
 	retObj = srcFsPathPtr->translatedPathPtr;
     }
 
+    Tcl_IncrRefCount(retObj);
     return retObj;
 }
 
@@ -5123,7 +5133,13 @@ Tcl_FSGetTranslatedStringPath(interp, pathPtr)
     Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
 
     if (transPtr != NULL) {
-	return Tcl_GetString(transPtr);
+	int len;
+	CONST char *result, *orig;
+	orig = Tcl_GetStringFromObj(transPtr, &len);
+	result = (char*) ckalloc((unsigned)(len+1));
+	memcpy((VOID*) result, (VOID*) orig, (size_t) (len+1));
+	Tcl_DecrRefCount(transPtr);
+	return result;
     }
 
     return NULL;
@@ -5330,17 +5346,69 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr)
 	 * that call can actually result in a lot of other filesystem
 	 * action, which might loop back through here.
 	 */
-	if ((path[0] != '\0') && 
-	  (Tcl_FSGetPathType(pathObjPtr) == TCL_PATH_RELATIVE)) {
-	    useThisCwd = Tcl_FSGetCwd(interp);
+	if (path[0] != '\0') {
+	    Tcl_PathType type = Tcl_FSGetPathType(pathObjPtr);
+	    if (type == TCL_PATH_RELATIVE) {
+		useThisCwd = Tcl_FSGetCwd(interp);
 
-	    if (useThisCwd == NULL) {
-		return NULL;
-	    }
+		if (useThisCwd == NULL) return NULL;
 
-	    absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
-	    Tcl_IncrRefCount(absolutePath);
-	    /* We have a refCount on the cwd */
+		absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
+		Tcl_IncrRefCount(absolutePath);
+		/* We have a refCount on the cwd */
+#ifdef __WIN32__
+	    } else if (type == TCL_PATH_VOLUME_RELATIVE) {
+		/* 
+		 * Only Windows has volume-relative paths.  These
+		 * paths are rather rare, but is is nice if Tcl can
+		 * handle them.  It is much better if we can
+		 * handle them here, rather than in the native fs code,
+		 * because we really need to have a real absolute path
+		 * just below.
+		 * 
+		 * We do not let this block compile on non-Windows
+		 * platforms because the test suite's manual forcing
+		 * of tclPlatform can otherwise cause this code path
+		 * to be executed, causing various errors because
+		 * volume-relative paths really do not exist.
+		 */
+		useThisCwd = Tcl_FSGetCwd(interp);
+		if (useThisCwd == NULL) return NULL;
+		
+		if (path[0] == '/') {
+		    /* 
+		     * Path of form /foo/bar which is a path in the
+		     * root directory of the current volume.
+		     */
+		    CONST char *drive = Tcl_GetString(useThisCwd);
+		    absolutePath = Tcl_NewStringObj(drive,2);
+		    Tcl_AppendToObj(absolutePath, path, -1);
+		    Tcl_IncrRefCount(absolutePath);
+		    /* We have a refCount on the cwd */
+		} else {
+		    /* 
+		     * Path of form C:foo/bar, but this only makes
+		     * sense if the cwd is also on drive C.
+		     */
+		    CONST char *drive = Tcl_GetString(useThisCwd);
+		    char drive_c = path[0];
+		    if (drive_c >= 'a') {
+			drive_c -= ('a' - 'A');
+		    }
+		    if (drive[0] == drive_c) {
+			absolutePath = Tcl_DuplicateObj(useThisCwd);
+			Tcl_IncrRefCount(absolutePath);
+			Tcl_AppendToObj(absolutePath, "/", 1);
+			Tcl_AppendToObj(absolutePath, path+2, -1);
+			/* We have a refCount on the cwd */
+		    } else {
+			/* We just can't handle it correctly here */
+			Tcl_DecrRefCount(useThisCwd);
+			useThisCwd = NULL;
+		    }
+		}
+#endif /* __WIN32__ */
+	    }
 	}
 	/* Already has refCount incremented */
 	fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath, 
diff --git a/mac/tclMacFile.c b/mac/tclMacFile.c
index 0311ecd..2c6526a 100644
--- a/mac/tclMacFile.c
+++ b/mac/tclMacFile.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: tclMacFile.c,v 1.27 2003/03/03 20:22:43 das Exp $
+ * RCS: @(#) $Id: tclMacFile.c,v 1.27.2.1 2003/10/03 17:45:37 vincentdarley Exp $
  */
 
 /*
@@ -178,6 +178,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
 	
 	if (TclpObjLstat(fileNamePtr, &buf) != 0) {
 	    /* File doesn't exist */
+	    Tcl_DecrRefCount(fileNamePtr);
 	    return TCL_OK;
 	}
 
@@ -202,6 +203,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
 		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
 	    }
 	}
+	Tcl_DecrRefCount(fileNamePtr);
 	return TCL_OK;
     } else {
 	char *fname;
@@ -258,6 +260,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
 	    
 	    if ((err != noErr) || !isDirectory) {
 		Tcl_DStringFree(&dsOrig);
+		Tcl_DecrRefCount(fileNamePtr);
 		return TCL_OK;
 	    }
 	}
@@ -326,6 +329,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
 	}
 
 	Tcl_DStringFree(&dsOrig);
+	Tcl_DecrRefCount(fileNamePtr);
 	return result;
     }
 }
@@ -1211,6 +1215,7 @@ TclpObjLink(pathPtr, toPtr, linkAction)
 	    Tcl_IncrRefCount(link);
 	    Tcl_DStringFree(&ds);
 	}
+	Tcl_DecrRefCount(transPtr);
     }
     return link;
 }
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 72f6846..a439511 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.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: tclUnixFCmd.c,v 1.28.2.1 2003/07/16 15:28:30 dgp Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.28.2.2 2003/10/03 17:45:37 vincentdarley Exp $
  *
  * Portions of this code were derived from NetBSD source code which has
  * the following copyright notice:
@@ -624,13 +624,22 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
     Tcl_DString ds;
     Tcl_DString srcString, dstString;
     int ret;
-
+    Tcl_Obj *transPtr;
+    
+    transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr);
     Tcl_UtfToExternalDString(NULL, 
-			     Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), 
+			     (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), 
 			     -1, &srcString);
+    if (transPtr != NULL) {
+	Tcl_DecrRefCount(transPtr);
+    }
+    transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr);
     Tcl_UtfToExternalDString(NULL, 
-			     Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), 
+			     (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), 
 			     -1, &dstString);
+    if (transPtr != NULL) {
+	Tcl_DecrRefCount(transPtr);
+    }
 
     ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds);
 
@@ -681,9 +690,14 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
     Tcl_DString ds;
     Tcl_DString pathString;
     int ret;
+    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
 
-    Tcl_UtfToExternalDString(NULL, Tcl_FSGetTranslatedStringPath(NULL, pathPtr), 
+    Tcl_UtfToExternalDString(NULL, 
+			     (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), 
 			     -1, &pathString);
+    if (transPtr != NULL) {
+	Tcl_DecrRefCount(transPtr);
+    }
     ret = DoRemoveDirectory(&pathString, recursive, &ds);
     Tcl_DStringFree(&pathString);
 
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 3e74d16..fe9f067 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.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: tclUnixFile.c,v 1.32 2003/02/12 18:57:52 vincentdarley Exp $
+ * RCS: @(#) $Id: tclUnixFile.c,v 1.32.2.1 2003/10/03 17:45:37 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -255,7 +255,8 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
 		dirLength++;
 	    }
 	}
-
+	Tcl_DecrRefCount(fileNamePtr);
+	
 	/*
 	 * Now open the directory for reading and iterate over the contents.
 	 */
@@ -745,10 +746,14 @@ TclpObjLink(pathPtr, toPtr, linkAction)
 	char link[MAXPATHLEN];
 	int length;
 	Tcl_DString ds;
-
-	if (Tcl_FSGetTranslatedPath(NULL, pathPtr) == NULL) {
+	Tcl_Obj *transPtr;
+	
+	transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+	if (transPtr == NULL) {
 	    return NULL;
 	}
+	Tcl_DecrRefCount(transPtr);
+	
 	length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
 	if (length < 0) {
 	    return NULL;
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 621d352..3992fb2 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.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: tclWinFCmd.c,v 1.35 2003/02/07 15:29:33 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinFCmd.c,v 1.35.2.1 2003/10/03 17:45:37 vincentdarley Exp $
  */
 
 #include "tclWinInt.h"
@@ -854,12 +854,13 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
 {
     Tcl_DString ds;
     Tcl_DString srcString, dstString;
+    Tcl_Obj *normSrcPtr, *normDestPtr;
     int ret;
 
-    Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), 
-		      -1, &srcString);
-    Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), 
-		      -1, &dstString);
+    normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr);
+    Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString);
+    normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr);
+    Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString);
 
     ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);
 
@@ -867,7 +868,13 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
     Tcl_DStringFree(&dstString);
 
     if (ret != TCL_OK) {
-	*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+	if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normSrcPtr))) {
+	    *errorPtr = srcPathPtr;
+	} else if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normDestPtr))) {
+	    *errorPtr = destPathPtr;
+	} else {
+	    *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+	}
 	Tcl_DStringFree(&ds);
 	Tcl_IncrRefCount(*errorPtr);
     }
@@ -910,6 +917,7 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
     Tcl_Obj **errorPtr;
 {
     Tcl_DString ds;
+    Tcl_Obj *normPtr = NULL;
     int ret;
     if (recursive) {
 	/* 
@@ -918,8 +926,8 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
 	 * optimize this case easily.
 	 */
 	Tcl_DString native;
-	Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), 
-			  -1, &native);
+	normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+	Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native);
 	ret = DoRemoveDirectory(&native, recursive, &ds);
 	Tcl_DStringFree(&native);
     } else {
@@ -929,7 +937,12 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
     if (ret != TCL_OK) {
 	int len = Tcl_DStringLength(&ds);
 	if (len > 0) {
-	    *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+	    if (normPtr != NULL 
+	      && !strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normPtr))) {
+		*errorPtr = pathPtr;
+	    } else {
+		*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+	    }
 	    Tcl_IncrRefCount(*errorPtr);
 	}
 	Tcl_DStringFree(&ds);
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index f1f1ffa..13a2c48 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinFile.c,v 1.44.2.5 2003/07/17 00:16:04 hobbs Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.44.2.6 2003/10/03 17:45:37 vincentdarley Exp $
  */
 
 //#define _WIN32_WINNT  0x0500
@@ -818,7 +818,8 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
 	    }
 	}
 	dirName = Tcl_DStringValue(&dirString);
-
+	Tcl_DecrRefCount(fileNamePtr);
+	
 	/*
 	 * First verify that the specified path is actually a directory.
 	 */
@@ -1556,9 +1557,13 @@ TclpObjStat(pathPtr, statPtr)
 
     transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
     if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) {
+	if (transPtr != NULL) {
+	    Tcl_DecrRefCount(transPtr);
+	}
 	Tcl_SetErrno(ENOENT);
 	return -1;
     }
+    Tcl_DecrRefCount(transPtr);
 #endif
     
     /*