diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclFileName.c | 11 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 90 | ||||
| -rw-r--r-- | mac/tclMacFile.c | 7 | ||||
| -rw-r--r-- | unix/tclUnixFCmd.c | 24 | ||||
| -rw-r--r-- | unix/tclUnixFile.c | 13 | ||||
| -rw-r--r-- | win/tclWinFCmd.c | 31 | ||||
| -rw-r--r-- | win/tclWinFile.c | 9 |
8 files changed, 155 insertions, 37 deletions
@@ -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 /* |