summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2003-06-23 10:14:02 (GMT)
committervincentdarley <vincentdarley>2003-06-23 10:14:02 (GMT)
commite42bd5945d15a3616dc2412e70037724fbe20e37 (patch)
tree5df14649c5f9d7fb26d0a5440941db51293c8936
parent2d0356834339b6ced61df5517004e0943e44b5c5 (diff)
downloadtcl-e42bd5945d15a3616dc2412e70037724fbe20e37.zip
tcl-e42bd5945d15a3616dc2412e70037724fbe20e37.tar.gz
tcl-e42bd5945d15a3616dc2412e70037724fbe20e37.tar.bz2
filesystem fixes -- see ChangeLog
-rw-r--r--ChangeLog12
-rw-r--r--generic/tclFCmd.c10
-rw-r--r--tests/fCmd.test12
-rw-r--r--win/tclWin32Dll.c22
-rw-r--r--win/tclWinFile.c117
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;
}