summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclFileName.c8
-rw-r--r--generic/tclFileSystem.h3
-rw-r--r--generic/tclIOUtil.c179
-rw-r--r--generic/tclPathObj.c23
4 files changed, 126 insertions, 87 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 0307ee1..9736096 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.55 2004/05/08 15:51:41 vincentdarley Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.56 2004/09/27 15:00:26 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -240,6 +240,12 @@ Tcl_GetPathType(path)
* tclIOUtil.c (but needs to be here due to its dependence on
* static variables/functions in this file). The exported
* function Tcl_FSGetPathType should be used by extensions.
+ *
+ * Note that '~' paths are always considered TCL_PATH_ABSOLUTE,
+ * even though expanding the '~' could lead to any possible
+ * path type. This function should therefore be considered a
+ * low-level, string-manipulation function only -- it doesn't
+ * actually do any expansion in making its determination.
*
* Results:
* Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index d63f7d5..2fe4bd6 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -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: tclFileSystem.h,v 1.7 2004/05/07 07:44:37 vincentdarley Exp $
+ * RCS: @(#) $Id: tclFileSystem.h,v 1.8 2004/09/27 15:00:39 vincentdarley Exp $
*/
/*
@@ -98,4 +98,5 @@ Tcl_PathType TclFSNonnativePathType _ANSI_ARGS_((CONST char *pathPtr,
Tcl_PathType TclGetPathType _ANSI_ARGS_((Tcl_Obj *pathPtr,
Tcl_Filesystem **filesystemPtrPtr,
int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
+int TclFSEpochOk _ANSI_ARGS_((int filesystemEpoch));
Tcl_FSPathInFilesystemProc TclNativePathInFilesystem;
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 18dfc58..1e30134 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.108 2004/08/31 09:20:09 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.109 2004/09/27 15:00:39 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -621,6 +621,25 @@ FsGetFirstFilesystem(void) {
return fsRecPtr;
}
+/*
+ * The epoch can be changed both by filesystems being added or
+ * removed and by env(HOME) changing.
+ */
+int
+TclFSEpochOk (filesystemEpoch)
+ int filesystemEpoch;
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+#ifndef TCL_THREADS
+ tsdPtr->filesystemEpoch = theFilesystemEpoch;
+#else
+ Tcl_MutexLock(&filesystemMutex);
+ tsdPtr->filesystemEpoch = theFilesystemEpoch;
+ Tcl_MutexUnlock(&filesystemMutex);
+#endif
+ return (filesystemEpoch == tsdPtr->filesystemEpoch);
+}
+
/*
* If non-NULL, clientData is owned by us and must be freed later.
*/
@@ -2635,12 +2654,20 @@ Tcl_FSChdir(pathPtr)
if (fsPtr != NULL) {
Tcl_FSChdirProc *proc = fsPtr->chdirProc;
if (proc != NULL) {
+ /*
+ * If this fails, an appropriate errno will have
+ * been stored using 'Tcl_SetErrno()'.
+ */
retVal = (*proc)(pathPtr);
} else {
/* Fallback on stat-based implementation */
Tcl_StatBuf buf;
- /* If the file can be stat'ed and is a directory and
- * is readable, then we can chdir. */
+ /*
+ * If the file can be stat'ed and is a directory and is
+ * readable, then we can chdir. If any of these actions
+ * fail, then 'Tcl_SetErrno()' should automatically have
+ * been called to set an appropriate error code
+ */
if ((Tcl_FSStat(pathPtr, &buf) == 0)
&& (S_ISDIR(buf.st_mode))
&& (Tcl_FSAccess(pathPtr, R_OK) == 0)) {
@@ -2648,88 +2675,86 @@ Tcl_FSChdir(pathPtr)
retVal = 0;
}
}
+ } else {
+ Tcl_SetErrno(ENOENT);
}
+
+ /*
+ * The cwd changed, or an error was thrown. If an error was
+ * thrown, we can just continue (and that will report the error
+ * to the user). If there was no error we must assume that the
+ * cwd was actually changed to the normalized value we
+ * calculated above, and we must therefore cache that
+ * information.
+ */
- if (retVal != -1) {
- /*
- * The cwd changed, or an error was thrown. If an error was
- * thrown, we can just continue (and that will report the error
- * to the user). If there was no error we must assume that the
- * cwd was actually changed to the normalized value we
- * calculated above, and we must therefore cache that
- * information.
- */
+ /*
+ * If the filesystem in question has a getCwdProc, then the
+ * correct logic which performs the part below is already part
+ * of the Tcl_FSGetCwd() call, so no need to replicate it again.
+ * This will have a side effect though. The private
+ * authoritative representation of the current working directory
+ * stored in cwdPathPtr in static memory will be out-of-sync
+ * with the real OS-maintained value. The first call to
+ * Tcl_FSGetCwd will however recalculate the private copy to
+ * match the OS-value so everything will work right.
+ *
+ * However, if there is no getCwdProc, then we _must_ update
+ * our private storage of the cwd, since this is the only
+ * opportunity to do that!
+ *
+ * Note: We currently call this block of code irrespective of
+ * whether there was a getCwdProc or not, but the code should
+ * all in principle work if we only call this block if
+ * fsPtr->getCwdProc == NULL.
+ */
- /*
- * If the filesystem in question has a getCwdProc, then the
- * correct logic which performs the part below is already part
- * of the Tcl_FSGetCwd() call, so no need to replicate it again.
- * This will have a side effect though. The private
- * authoritative representation of the current working directory
- * stored in cwdPathPtr in static memory will be out-of-sync
- * with the real OS-maintained value. The first call to
- * Tcl_FSGetCwd will however recalculate the private copy to
- * match the OS-value so everything will work right.
- *
- * However, if there is no getCwdProc, then we _must_ update
- * our private storage of the cwd, since this is the only
- * opportunity to do that!
- *
- * Note: We currently call this block of code irrespective of
- * whether there was a getCwdProc or not, but the code should
- * all in principle work if we only call this block if
- * fsPtr->getCwdProc == NULL.
+ if (retVal == 0) {
+ /*
+ * Note that this normalized path may be different to what
+ * we found above (or at least a different object), if the
+ * filesystem epoch changed recently. This can actually
+ * happen with scripted documents very easily. Therefore
+ * we ask for the normalized path again (the correct value
+ * will have been cached as a result of the
+ * Tcl_FSGetFileSystemForPath call above anyway).
*/
-
- if (retVal == 0) {
+ Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ if (normDirName == NULL) {
+ /* Not really true, but what else to do? */
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
+ if (fsPtr == &tclNativeFilesystem) {
/*
- * Note that this normalized path may be different to what
- * we found above (or at least a different object), if the
- * filesystem epoch changed recently. This can actually
- * happen with scripted documents very easily. Therefore
- * we ask for the normalized path again (the correct value
- * will have been cached as a result of the
- * Tcl_FSGetFileSystemForPath call above anyway).
+ * For the native filesystem, we keep a cache of the
+ * native representation of the cwd. But, we want to do
+ * that for the exact format that is returned by
+ * 'getcwd' (so that we can later compare the two
+ * representations for equality), which might not be
+ * exactly the same char-string as the native
+ * representation of the fully normalized path (e.g. on
+ * Windows there's a forward-slash vs backslash
+ * difference). Hence we ask for this again here. On
+ * Unix it might actually be true that we always have
+ * the correct form in the native rep in which case we
+ * could simply use:
+ *
+ * cd = Tcl_FSGetNativePath(pathPtr);
+ *
+ * instead. This should be examined by someone on
+ * Unix.
*/
- Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
- if (normDirName == NULL) {
- /* Not really true, but what else to do? */
- Tcl_SetErrno(ENOENT);
- return -1;
- }
- if (fsPtr == &tclNativeFilesystem) {
- /*
- * For the native filesystem, we keep a cache of the
- * native representation of the cwd. But, we want to do
- * that for the exact format that is returned by
- * 'getcwd' (so that we can later compare the two
- * representations for equality), which might not be
- * exactly the same char-string as the native
- * representation of the fully normalized path (e.g. on
- * Windows there's a forward-slash vs backslash
- * difference). Hence we ask for this again here. On
- * Unix it might actually be true that we always have
- * the correct form in the native rep in which case we
- * could simply use:
- *
- * cd = Tcl_FSGetNativePath(pathPtr);
- *
- * instead. This should be examined by someone on
- * Unix.
- */
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
- ClientData cd;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ClientData cd;
- /* Assumption we are using a filesystem version 2 */
- TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)fsPtr->getCwdProc;
- cd = (*proc2)(tsdPtr->cwdClientData);
- FsUpdateCwd(normDirName, TclNativeDupInternalRep(cd));
- } else {
- FsUpdateCwd(normDirName, NULL);
- }
+ /* Assumption we are using a filesystem version 2 */
+ TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)fsPtr->getCwdProc;
+ cd = (*proc2)(tsdPtr->cwdClientData);
+ FsUpdateCwd(normDirName, TclNativeDupInternalRep(cd));
+ } else {
+ FsUpdateCwd(normDirName, NULL);
}
- } else {
- Tcl_SetErrno(ENOENT);
}
return (retVal);
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index b27b6b5..9ce22e5 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.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: tclPathObj.c,v 1.33 2004/06/10 16:55:39 dgp Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.34 2004/09/27 15:00:40 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -491,7 +491,8 @@ TclPathPart(interp, pathPtr, portion)
{
if (pathPtr->typePtr == &tclFsPathType) {
FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
- if (PATHFLAGS(pathPtr) != 0) {
+ if (TclFSEpochOk(fsPathPtr->filesystemEpoch)
+ && (PATHFLAGS(pathPtr) != 0)) {
switch (portion) {
case TCL_PATH_DIRNAME: {
/*
@@ -999,8 +1000,6 @@ Tcl_FSConvertToPathType(interp, pathPtr)
Tcl_Obj *pathPtr; /* Object to convert to a valid, current
* path type. */
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
/*
* While it is bad practice to examine an object's type directly,
* this is actually the best thing to do here. The reason is that
@@ -1012,7 +1011,7 @@ Tcl_FSConvertToPathType(interp, pathPtr)
*/
if (pathPtr->typePtr == &tclFsPathType) {
FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
- if (fsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) {
+ if (!TclFSEpochOk(fsPathPtr->filesystemEpoch)) {
if (pathPtr->bytes == NULL) {
UpdateStringOfFsPath(pathPtr);
}
@@ -1691,7 +1690,16 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
* action, which might loop back through here.
*/
if (path[0] != '\0') {
- Tcl_PathType type = Tcl_FSGetPathType(pathPtr);
+ Tcl_PathType type;
+ /*
+ * We don't ask for the type of 'pathPtr' here, because
+ * that is not correct for our purposes when we have a
+ * path like '~'. Tcl has a bit of a contradiction in
+ * that '~' paths are defined as 'absolute', but in
+ * reality can be just about anything, depending on
+ * how env(HOME) is set.
+ */
+ type = Tcl_FSGetPathType(absolutePath);
if (type == TCL_PATH_RELATIVE) {
useThisCwd = Tcl_FSGetCwd(interp);
@@ -1941,7 +1949,6 @@ TclFSEnsureEpochOk(pathPtr, fsPtrPtr)
Tcl_Filesystem **fsPtrPtr;
{
FsPath* srcFsPathPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
if (pathPtr->typePtr != &tclFsPathType) {
return TCL_OK;
@@ -1953,7 +1960,7 @@ TclFSEnsureEpochOk(pathPtr, fsPtrPtr)
* Check if the filesystem has changed in some way since
* this object's internal representation was calculated.
*/
- if (srcFsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) {
+ if (!TclFSEpochOk(srcFsPathPtr->filesystemEpoch)) {
/*
* We have to discard the stale representation and
* recalculate it