diff options
| -rw-r--r-- | ChangeLog | 12 | ||||
| -rw-r--r-- | generic/tclFCmd.c | 10 | ||||
| -rw-r--r-- | tests/fCmd.test | 12 | ||||
| -rw-r--r-- | win/tclWin32Dll.c | 22 | ||||
| -rw-r--r-- | win/tclWinFile.c | 117 |
5 files changed, 118 insertions, 55 deletions
@@ -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; } |