filesystem fixes -- see ChangeLog

5 files changed, 118 insertions, 55 deletions

diff --git a/ChangeLog b/ChangeLog
index 9c512bc..7a1ca04 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2003-06-23  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* generic/tclFCmd.c: fix to bad error message when trying to
+        do 'file copy foo ""'. [Bug 756951]
+        * tests/fCmd.test: added two new tests for the bug.
+
+	* win/tclWinFile.c:
+	* win/tclWin32Dll.c: recommitted some filesystem globbing 
+        speed-ups, but disabled some on the older Win 95/98/ME where
+        they don't seem to work.
+
 2003-06-18  Miguel Sofer <msofer@users.sf.net>
 
 	* generic/tclNamesp.c (Tcl_Export): removed erroneous comments
@@ -11,6 +22,7 @@
 	* generic/tclCmdMZ.c:
 	* tests/regexp.test: fixing of bugs related to regexp and regsub
         matching of empty strings.  Addition of a number of new tests.
+        [Bug 755335]
 
 2003-06-16  Andreas Kupries  <andreask@activestate.com>
 
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 0d1cc76..fb4a880 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.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: tclFCmd.c,v 1.21 2003/05/14 19:21:22 das Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.22 2003/06/23 10:14:02 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -658,6 +658,14 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
 	     * so it should be quite clear 
 	     */
 	    errfile = target;
+	    /* 
+	     * We now need to reset the result, because the above call,
+	     * if it failed, may have put an error message in place.
+	     * (Ideally we would prefer not to pass an interpreter in
+	     * above, but the channel IO code used by
+	     * TclCrossFilesystemCopy currently requires one)
+	     */
+	    Tcl_ResetResult(interp);
 	}
     }
     if ((copyFlag == 0) && (result == TCL_OK)) {
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 5b2a89f..95da8d7 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.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: fCmd.test,v 1.28 2003/06/02 15:58:46 vincentdarley Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.29 2003/06/23 10:14:02 vincentdarley Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -1026,6 +1026,16 @@ test fCmd-10.10 {file copy: comprehensive: source and target incompatible} \
     createfile tf1
     list [catch {file copy -force tf1 td1} msg] $msg
 } [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
+test fCmd-10.11 {file copy: copy to empty file name} {
+    cleanup
+    createfile tf1
+    list [catch {file copy tf1 ""} msg] $msg
+} {1 {error copying "tf1" to "": no such file or directory}}
+test fCmd-10.12 {file rename: rename to empty file name} {
+    cleanup
+    createfile tf1
+    list [catch {file rename tf1 ""} msg] $msg
+} {1 {error renaming "tf1" to "": no such file or directory}}
 cleanup    
 
 # old tests    
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index ded9c6f..1d6266b 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.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: tclWin32Dll.c,v 1.25 2003/04/11 16:00:08 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWin32Dll.c,v 1.26 2003/06/23 10:14:02 vincentdarley Exp $
  */
 
 #include "tclWinInt.h"
@@ -327,8 +327,8 @@ TclWinInit(hInst)
  * Results:
  *	The return value is one of:
  *	    VER_PLATFORM_WIN32s		Win32s on Windows 3.1. (not supported)
- *	    VER_PLATFORM_WIN32_WINDOWS	Win32 on Windows 95.
- *	    VER_PLATFORM_WIN32_NT	Win32 on Windows NT
+ *	    VER_PLATFORM_WIN32_WINDOWS	Win32 on Windows 95, 98, ME.
+ *	    VER_PLATFORM_WIN32_NT	Win32 on Windows NT, 2000, XP
  *
  * Side effects:
  *	None.
@@ -581,10 +581,18 @@ TclWinSetInterfaces(
 		  (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, 
 		  LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, 
 		  "CreateHardLinkA");
-		tclWinProcs->findFirstFileExProc = 
-		  (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
-		  LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, 
-		  "FindFirstFileExA");
+		tclWinProcs->findFirstFileExProc = NULL;
+		/*
+		 * The 'findFirstFileExProc' function exists on some
+		 * of 95/98/ME, but it seems not to work as anticipated.
+		 * Therefore we don't set this function pointer.  The
+		 * relevant code will fall back on a slower approach
+		 * using the normal findFirstFileProc.
+		 * 
+		 * (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
+		 * LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, 
+		 * "FindFirstFileExA");
+		 */
 		tclWinProcs->getVolumeNameForVMPProc = 
 		  (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, 
 		  DWORD)) GetProcAddress(hInstance, 
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index e09fb79..badf819 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.50 2003/05/16 01:48:43 hobbs Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.51 2003/06/23 10:14:02 vincentdarley Exp $
  */
 
 //#define _WIN32_WINNT  0x0500
@@ -777,77 +777,97 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
 	DWORD attr;
 	HANDLE handle;
 	WIN32_FIND_DATAT data;
-	CONST char *dirName;
+	CONST char *dirName;   /* utf-8 dir name, later 
+	                        * with pattern appended */
 	int dirLength;
 	int matchSpecialDots;
-	Tcl_DString ds;        /* native encoding of dir */
+	Tcl_DString ds;        /* native encoding of dir, also used
+	                        * temporarily for other things. */
 	Tcl_DString dsOrig;    /* utf-8 encoding of dir */
-	Tcl_DString dirString; /* utf-8 encoding of dir with \'s */
 	Tcl_Obj *fileNamePtr;
+	char lastChar;
 
 	/*
-	 * Convert the path to normalized form since some interfaces only
-	 * accept backslashes.  Also, ensure that the directory ends with a
-	 * separator character.
+	 * Get the normalized path representation 
+	 * (the main thing is we dont want any '~' sequences).
 	 */
 
-	fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+	fileNamePtr = Tcl_FSGetNormalizedPath(interp, pathPtr);
 	if (fileNamePtr == NULL) {
 	    return TCL_ERROR;
 	}
-	Tcl_DStringInit(&dsOrig);
-	dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
-	Tcl_DStringAppend(&dsOrig, dirName, dirLength);
-	
-	Tcl_DStringInit(&dirString);
-	if (dirLength == 0) {
-	    Tcl_DStringAppend(&dirString, ".\\", 2);
-	} else {
-	    char *p;
-
-	    Tcl_DStringAppend(&dirString, dirName, dirLength);
-	    for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
-		if (*p == '/') {
-		    *p = '\\';
-		}
-	    }
-	    p--;
-	    /* Make sure we have a trailing directory delimiter */
-	    if ((*p != '\\') && (*p != ':')) {
-		Tcl_DStringAppend(&dirString, "\\", 1);
-		Tcl_DStringAppend(&dsOrig, "/", 1);
-		dirLength++;
-	    }
-	}
-	dirName = Tcl_DStringValue(&dirString);
 
 	/*
-	 * First verify that the specified path is actually a directory.
+	 * Verify that the specified path exists and 
+	 * is actually a directory.
 	 */
-
-	native = Tcl_WinUtfToTChar(dirName, Tcl_DStringLength(&dirString),
-		&ds);
+	native = Tcl_FSGetNativePath(pathPtr);
+	if (native == NULL) {
+	    return TCL_OK;
+	}
 	attr = (*tclWinProcs->getFileAttributesProc)(native);
-	Tcl_DStringFree(&ds);
 
 	if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
-	    Tcl_DStringFree(&dirString);
 	    return TCL_OK;
 	}
 
+	/* 
+	 * Build up the directory name for searching, including
+	 * a trailing directory separator.
+	 */
+
+	Tcl_DStringInit(&dsOrig);
+	dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
+	Tcl_DStringAppend(&dsOrig, dirName, dirLength);
+	
+	lastChar = dirName[dirLength -1];
+	if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
+	    Tcl_DStringAppend(&dsOrig, "/", 1);
+	    dirLength++;
+	}
+	dirName = Tcl_DStringValue(&dsOrig);
+
 	/*
-	 * We need to check all files in the directory, so append a *.*
-	 * to the path. 
+	 * We need to check all files in the directory, so we append
+	 * '*.*' to the path, unless the pattern we've been given is
+	 * rather simple, when we can use that instead.
 	 */
 
-	dirName = Tcl_DStringAppend(&dirString, "*.*", 3);
+	if (strpbrk(pattern, "[]\\") == NULL) {
+	    /* 
+	     * The pattern is a simple one containing just '*' and/or '?'.
+	     * This means we can get the OS to help us, by passing
+	     * it the pattern.
+	     */
+	    dirName = Tcl_DStringAppend(&dsOrig, pattern, -1);
+	} else {
+	    dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3);
+	}
 	native = Tcl_WinUtfToTChar(dirName, -1, &ds);
-	handle = (*tclWinProcs->findFirstFileProc)(native, &data);
+	if (tclWinProcs->findFirstFileExProc == NULL 
+	    || (types == NULL)
+	    || (types->type != TCL_GLOB_TYPE_DIR)) {
+	    handle = (*tclWinProcs->findFirstFileProc)(native, &data);
+	} else {
+	    /* We can be more efficient, for pure directory requests */
+	    handle = (*tclWinProcs->findFirstFileExProc)(native, 
+			FindExInfoStandard, &data, 
+			FindExSearchLimitToDirectories, NULL, 0);
+	}
 	Tcl_DStringFree(&ds);
 
 	if (handle == INVALID_HANDLE_VALUE) {
-	    Tcl_DStringFree(&dirString);
-	    TclWinConvertError(GetLastError());
+	    DWORD err = GetLastError();
+	    if (err == ERROR_FILE_NOT_FOUND) {
+	        /* 
+	         * We used our 'pattern' above, and matched nothing
+	         * This means we just return TCL_OK, indicating
+	         * no results found.
+	         */
+		Tcl_DStringFree(&dsOrig);
+		return TCL_OK;
+	    }
+	    TclWinConvertError(err);
 	    Tcl_ResetResult(interp);
 	    Tcl_AppendResult(interp, "couldn't read directory \"",
 		    Tcl_DStringValue(&dsOrig), "\": ", 
@@ -856,6 +876,12 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
 	    return TCL_ERROR;
 	}
 
+	/* 
+	 * We may use this later, so we must restore it to its
+	 * length including the directory delimiter
+	 */
+	Tcl_DStringSetLength(&dsOrig, dirLength);
+
 	/*
 	 * Check to see if the pattern should match the special
 	 * . and .. names, referring to the current directory,
@@ -949,7 +975,6 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
 	} while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE);
 
 	FindClose(handle);
-	Tcl_DStringFree(&dirString);
 	Tcl_DStringFree(&dsOrig);
 	return TCL_OK;
     }