summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2003-10-03 17:45:36 (GMT)
committervincentdarley <vincentdarley>2003-10-03 17:45:36 (GMT)
commit961ab79192fe2d6378d8903dca25ceaa6d4a97b8 (patch)
tree60e58def2b9c6ca8559eb36ce4d18dcb276d6fe3
parent5e610d838ab3c6b8398b2ae540ca3d73f2025e8a (diff)
downloadtcl-961ab79192fe2d6378d8903dca25ceaa6d4a97b8.zip
tcl-961ab79192fe2d6378d8903dca25ceaa6d4a97b8.tar.gz
tcl-961ab79192fe2d6378d8903dca25ceaa6d4a97b8.tar.bz2
backporting of filesystem tests, docs
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclFileName.c11
-rw-r--r--generic/tclIOUtil.c90
-rw-r--r--mac/tclMacFile.c7
-rw-r--r--unix/tclUnixFCmd.c24
-rw-r--r--unix/tclUnixFile.c13
-rw-r--r--win/tclWinFCmd.c31
-rw-r--r--win/tclWinFile.c9
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
/*