summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclIOUtil.c680
-rw-r--r--generic/tclInt.h4
2 files changed, 574 insertions, 110 deletions
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 0b739dc..6c7b9c0 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.71 2003/02/04 17:06:50 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.72 2003/02/10 10:26:25 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -37,12 +37,16 @@
static void DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr));
static void FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
+static void UpdateStringOfFsPath _ANSI_ARGS_((Tcl_Obj *objPtr));
static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
+static Tcl_Obj* MakeFsPathFromRelative _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_Obj *cwdPtr));
static Tcl_Obj* FSNormalizeAbsolutePath
_ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));
static int TclNormalizeToUniquePath
- _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr));
+ _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ int startAt));
static int SetFsPathFromAbsoluteNormalized
_ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr));
static int FindSplitPos _ANSI_ARGS_((char *path, char *separator));
@@ -61,7 +65,7 @@ Tcl_ObjType tclFsPathType = {
"path", /* name */
FreeFsPathInternalRep, /* freeIntRepProc */
DupFsPathInternalRep, /* dupIntRepProc */
- NULL, /* updateStringProc */
+ UpdateStringOfFsPath, /* updateStringProc */
SetFsPathFromAny /* setFromAnyProc */
};
@@ -495,7 +499,8 @@ typedef struct FsPath {
Tcl_Obj *cwdPtr; /* If null, path is absolute, else
* this points to the cwd object used
* for this path. We have a refCount
- * on the object. */
+ * on the object. */
+ int flags; /* Flags to describe interpretation */
ClientData nativePathPtr; /* Native representation of this path,
* which is filesystem dependent. */
int filesystemEpoch; /* Used to ensure the path representation
@@ -507,6 +512,8 @@ typedef struct FsPath {
* entry to use for this path. */
} FsPath;
+#define TCLPATH_APPENDED 1
+#define TCLPATH_RELATIVE 2
/*
* Used to implement Tcl_FSGetCwd in a file-system independent way.
* This is protected by the cwdMutex below.
@@ -597,7 +604,8 @@ FsReleaseIterator(void) {
*/
void
-TclFinalizeFilesystem() {
+TclFinalizeFilesystem()
+{
/*
* Assumption that only one thread is active now. Otherwise
* we would need to put various mutexes around this code.
@@ -658,7 +666,8 @@ TclFinalizeFilesystem() {
*/
void
-TclResetFilesystem() {
+TclResetFilesystem()
+{
filesystemList = &nativeFilesystemRecord;
/*
* Note, at this point, I believe nativeFilesystemRecord ->
@@ -996,9 +1005,11 @@ FSNormalizeAbsolutePath(interp, pathPtr)
Tcl_Interp* interp; /* Interpreter to use */
Tcl_Obj *pathPtr; /* Absolute path to normalize */
{
- int splen = 0, nplen, i;
+ int splen = 0, nplen, eltLen, i;
+ char *eltName;
Tcl_Obj *retVal;
Tcl_Obj *split;
+ Tcl_Obj *elt;
/* Split has refCount zero */
split = Tcl_FSSplitPath(pathPtr, &splen);
@@ -1009,13 +1020,14 @@ FSNormalizeAbsolutePath(interp, pathPtr)
* is the top-level entry, i.e. the name of a volume.
*/
nplen = 0;
- for (i = 0;i < splen;i++) {
- Tcl_Obj *elt;
+ for (i = 0; i < splen; i++) {
Tcl_ListObjIndex(NULL, split, nplen, &elt);
-
- if (strcmp(Tcl_GetString(elt), ".") == 0) {
+ eltName = Tcl_GetStringFromObj(elt, &eltLen);
+
+ if ((eltLen == 1) && (eltName[0] == '.')) {
Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);
- } else if (strcmp(Tcl_GetString(elt), "..") == 0) {
+ } else if ((eltLen == 2)
+ && (eltName[0] == '.') && (eltName[1] == '.')) {
if (nplen > 1) {
nplen--;
Tcl_ListObjReplace(NULL, split, nplen, 2, 0, NULL);
@@ -1040,7 +1052,7 @@ FSNormalizeAbsolutePath(interp, pathPtr)
* other criteria for normalizing a path.
*/
Tcl_IncrRefCount(retVal);
- TclNormalizeToUniquePath(interp, retVal);
+ TclNormalizeToUniquePath(interp, retVal, 0);
/*
* Since we know it is a normalized path, we can
* actually convert this object into an FsPath for
@@ -1082,29 +1094,32 @@ FSNormalizeAbsolutePath(interp, pathPtr)
* us a unique, case-dependent path).
*
* Results:
- * The result is returned in a Tcl_Obj with a refCount of 1,
- * which is therefore owned by the caller. It must be
- * freed (with Tcl_DecrRefCount) by the caller when no longer needed.
+ * The pathPtr is modified in place. The return value is
+ * the last byte offset which was recognised in the path
+ * string.
*
* Side effects:
* None (beyond the memory allocation for the result).
*
- * Special note:
- * This is only used by the above function. Also if the
- * filesystem-specific normalizePathProcs can re-introduce
+ * Special notes:
+ * If the filesystem-specific normalizePathProcs can re-introduce
* ../, ./ sequences into the path, then this function will
* not return the correct result. This may be possible with
* symbolic links on unix/macos.
*
+ * Important assumption: if startAt is non-zero, it must point
+ * to a directory separator that we know exists and is already
+ * normalized (so it is important not to point to the char just
+ * after the separator).
*---------------------------------------------------------------------------
*/
static int
-TclNormalizeToUniquePath(interp, pathPtr)
+TclNormalizeToUniquePath(interp, pathPtr, startAt)
Tcl_Interp *interp;
Tcl_Obj *pathPtr;
+ int startAt;
{
FilesystemRecord *fsRecPtr;
- int retVal = 0;
/*
* Call each of the "normalise path" functions in succession. This is
@@ -1118,7 +1133,7 @@ TclNormalizeToUniquePath(interp, pathPtr)
if (fsRecPtr == &nativeFilesystemRecord) {
Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
if (proc != NULL) {
- retVal = (*proc)(interp, pathPtr, retVal);
+ startAt = (*proc)(interp, pathPtr, startAt);
}
break;
}
@@ -1132,7 +1147,7 @@ TclNormalizeToUniquePath(interp, pathPtr)
if (fsRecPtr != &nativeFilesystemRecord) {
Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
if (proc != NULL) {
- retVal = (*proc)(interp, pathPtr, retVal);
+ startAt = (*proc)(interp, pathPtr, startAt);
}
/*
* We could add an efficiency check like this:
@@ -1146,7 +1161,7 @@ TclNormalizeToUniquePath(interp, pathPtr)
}
FsReleaseIterator();
- return (retVal);
+ return (startAt);
}
/*
@@ -1540,16 +1555,8 @@ Tcl_FSStat(pathPtr, buf)
{
Tcl_Filesystem *fsPtr;
#ifdef USE_OBSOLETE_FS_HOOKS
- StatProc *statProcPtr;
struct stat oldStyleStatBuffer;
int retVal = -1;
- char *path;
- Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
- if (transPtr == NULL) {
- path = NULL;
- } else {
- path = Tcl_GetString(transPtr);
- }
/*
* Call each of the "stat" function in succession. A non-return
@@ -1557,11 +1564,24 @@ Tcl_FSStat(pathPtr, buf)
*/
Tcl_MutexLock(&obsoleteFsHookMutex);
- statProcPtr = statProcList;
- while ((retVal == -1) && (statProcPtr != NULL)) {
- retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer);
- statProcPtr = statProcPtr->nextPtr;
+
+ if (statProcList != NULL) {
+ StatProc *statProcPtr;
+ char *path;
+ Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+ if (transPtr == NULL) {
+ path = NULL;
+ } else {
+ path = Tcl_GetString(transPtr);
+ }
+
+ statProcPtr = statProcList;
+ while ((retVal == -1) && (statProcPtr != NULL)) {
+ retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer);
+ statProcPtr = statProcPtr->nextPtr;
+ }
}
+
Tcl_MutexUnlock(&obsoleteFsHookMutex);
if (retVal != -1) {
/*
@@ -1663,15 +1683,7 @@ Tcl_FSAccess(pathPtr, mode)
{
Tcl_Filesystem *fsPtr;
#ifdef USE_OBSOLETE_FS_HOOKS
- AccessProc *accessProcPtr;
int retVal = -1;
- char *path;
- Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
- if (transPtr == NULL) {
- path = NULL;
- } else {
- path = Tcl_GetString(transPtr);
- }
/*
* Call each of the "access" function in succession. A non-return
@@ -1679,11 +1691,24 @@ Tcl_FSAccess(pathPtr, mode)
*/
Tcl_MutexLock(&obsoleteFsHookMutex);
- accessProcPtr = accessProcList;
- while ((retVal == -1) && (accessProcPtr != NULL)) {
- retVal = (*accessProcPtr->proc)(path, mode);
- accessProcPtr = accessProcPtr->nextPtr;
+
+ if (accessProcList != NULL) {
+ AccessProc *accessProcPtr;
+ char *path;
+ Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+ if (transPtr == NULL) {
+ path = NULL;
+ } else {
+ path = Tcl_GetString(transPtr);
+ }
+
+ accessProcPtr = accessProcList;
+ while ((retVal == -1) && (accessProcPtr != NULL)) {
+ retVal = (*accessProcPtr->proc)(path, mode);
+ accessProcPtr = accessProcPtr->nextPtr;
+ }
}
+
Tcl_MutexUnlock(&obsoleteFsHookMutex);
if (retVal != -1) {
return retVal;
@@ -1812,12 +1837,12 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
* for all files which match a given pattern. The appropriate
* function for the filesystem to which pathPtr belongs will be
* called. If pathPtr does not belong to any filesystem and if it
- * is NULL or the empty string, then we assume the pattern is to
- * be matched in the current working directory. To avoid each
- * filesystem's Tcl_FSMatchInDirectoryProc having to deal with
- * this issue, we create a pathPtr on the fly, and then remove it
- * from the results returned. This makes filesystems easy to
- * write, since they can assume the pathPtr passed to them
+ * is NULL or the empty string, then we assume the pattern is to be
+ * matched in the current working directory. To avoid each
+ * filesystem's Tcl_FSMatchInDirectoryProc having to deal with this
+ * issue, we create a pathPtr on the fly (equal to the cwd), and
+ * then remove it from the results returned. This makes filesystems
+ * easy to write, since they can assume the pathPtr passed to them
* is an ordinary path. In fact this means we could remove such
* special case handling from Tcl's native filesystems.
*
@@ -1837,7 +1862,8 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
*
* which must recurse through each directory matching '*' are
* handled internally by Tcl, by passing specific flags in a
- * modified 'types' parameter.
+ * modified 'types' parameter. This means the actual filesystem
+ * only ever sees patterns which match in a single directory.
*
* Side effects:
* The interpreter may have an error message inserted into it.
@@ -1899,10 +1925,9 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
if (proc != NULL) {
int cwdLen;
- Tcl_Obj *cwdDir;
char *cwdStr;
- char sep = 0;
Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL);
+ Tcl_IncrRefCount(tmpResultPtr);
/*
* We know the cwd is a normalised object which does
* not end in a directory delimiter, unless the cwd
@@ -1915,9 +1940,7 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
* either too much or too little below, leading to
* wrong answers returned by glob.
*/
- cwdDir = Tcl_DuplicateObj(cwd);
- Tcl_IncrRefCount(cwdDir);
- cwdStr = Tcl_GetStringFromObj(cwdDir, &cwdLen);
+ cwdStr = Tcl_GetStringFromObj(cwd, &cwdLen);
/*
* Should we perhaps use 'Tcl_FSPathSeparator'?
* But then what about the Windows special case?
@@ -1927,39 +1950,47 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
if (cwdStr[cwdLen-1] != '/') {
- sep = '/';
+ cwdLen++;
}
break;
case TCL_PLATFORM_WINDOWS:
- if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') {
- sep = '/';
+ if (cwdStr[cwdLen-1] != '/'
+ && cwdStr[cwdLen-1] != '\\') {
+ cwdLen++;
}
break;
case TCL_PLATFORM_MAC:
if (cwdStr[cwdLen-1] != ':') {
- sep = ':';
+ cwdLen++;
}
break;
}
- if (sep != 0) {
- Tcl_AppendToObj(cwdDir, &sep, 1);
- cwdLen++;
- /* Note: cwdStr may no longer be a valid pointer now */
- }
- ret = (*proc)(interp, tmpResultPtr, cwdDir, pattern, types);
- Tcl_DecrRefCount(cwdDir);
+ ret = (*proc)(interp, tmpResultPtr, cwd, pattern, types);
if (ret == TCL_OK) {
int resLength;
ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength);
if (ret == TCL_OK) {
- Tcl_Obj *elt, *cutElt;
- char *eltStr;
- int eltLen, i;
+ int i;
for (i = 0; i < resLength; i++) {
+ Tcl_Obj *cutElt, *elt;
+ char *eltStr;
+ int eltLen;
+
Tcl_ListObjIndex(interp, tmpResultPtr, i, &elt);
- eltStr = Tcl_GetStringFromObj(elt,&eltLen);
+ if (elt->typePtr == &tclFsPathType) {
+ FsPath* fsPathPtr = (FsPath*)
+ elt->internalRep.otherValuePtr;
+ if (fsPathPtr->flags != 0
+ && fsPathPtr->cwdPtr == cwd) {
+ Tcl_ListObjAppendElement(interp, result,
+ MakeFsPathFromRelative(interp,
+ fsPathPtr->normPathPtr, cwd));
+ continue;
+ }
+ }
+ eltStr = Tcl_GetStringFromObj(elt, &eltLen);
cutElt = Tcl_NewStringObj(eltStr + cwdLen,
eltLen - cwdLen);
Tcl_ListObjAppendElement(interp, result, cutElt);
@@ -3031,7 +3062,11 @@ FSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr)
} else {
FsPath *fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
if (fsPathPtr->cwdPtr != NULL) {
- return TCL_PATH_RELATIVE;
+ if (fsPathPtr->flags == 0) {
+ return TCL_PATH_RELATIVE;
+ }
+ return FSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr,
+ driveNameLengthPtr);
} else {
return GetPathType(pathObjPtr, filesystemPtrPtr,
driveNameLengthPtr, NULL);
@@ -3147,7 +3182,9 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
* we use the entire list.
*
* Results:
- * Returns object with refCount of zero.
+ * Returns object with refCount of zero, (or if non-zero, it has
+ * references elsewhere in Tcl). Either way, the caller must
+ * increment its refCount before use.
*
* Side effects:
* None.
@@ -3175,13 +3212,58 @@ Tcl_FSJoinPath(listObj, elements)
}
/*
* Correct this if it is too large, otherwise we will
- * waste our timing joining null elements to the path
+ * waste our time joining null elements to the path
*/
if (elements > listTest) {
elements = listTest;
}
}
+ if (elements == 2) {
+ /*
+ * This is a special case where we can be much more
+ * efficient
+ */
+ Tcl_Obj *base;
+
+ Tcl_ListObjIndex(NULL, listObj, 0, &base);
+ /*
+ * There is only any value in doing this if the first object is
+ * of path type, otherwise we'll never actually get any
+ * efficiency benefit elsewhere in the code (from re-using the
+ * normalized representation of the base object).
+ */
+ if (base->typePtr == &tclFsPathType) {
+ Tcl_Obj *tail;
+ Tcl_PathType type;
+ Tcl_ListObjIndex(NULL, listObj, 1, &tail);
+ type = GetPathType(tail, NULL, NULL, NULL);
+ if (type == TCL_PATH_RELATIVE) {
+ CONST char *str;
+ int len;
+ str = Tcl_GetStringFromObj(tail,&len);
+ if (len == 0) {
+ /*
+ * This happens if we try to handle the root volume
+ * '/'. There's no need to return a special path
+ * object, when the base itself is just fine!
+ */
+ return base;
+ }
+ if (str[0] != '.') {
+ return TclNewFSPathObj(base, str, len);
+ }
+ /*
+ * Otherwise we don't have an easy join, and
+ * we must let the more general code below handle
+ * things
+ */
+ } else {
+ return tail;
+ }
+ }
+ }
+
res = Tcl_NewObj();
for (i = 0; i < elements; i++) {
@@ -3746,7 +3828,6 @@ Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
*
*---------------------------------------------------------------------------
*/
-
int
Tcl_FSConvertToPathType(interp, objPtr)
Tcl_Interp *interp; /* Interpreter in which to store error
@@ -3766,10 +3847,14 @@ Tcl_FSConvertToPathType(interp, objPtr)
if (objPtr->typePtr == &tclFsPathType) {
FsPath *fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr;
if (fsPathPtr->filesystemEpoch != theFilesystemEpoch) {
+ if (objPtr->bytes == NULL) {
+ UpdateStringOfFsPath(objPtr);
+ }
FreeFsPathInternalRep(objPtr);
objPtr->typePtr = NULL;
return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
}
+ return TCL_OK;
if (fsPathPtr->cwdPtr == NULL) {
return TCL_OK;
} else {
@@ -3823,6 +3908,198 @@ FindSplitPos(path, separator)
/*
*---------------------------------------------------------------------------
*
+ * UpdateStringOfFsPath --
+ *
+ * Gives an object a valid string rep.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory may be allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfFsPath(objPtr)
+ register Tcl_Obj *objPtr; /* path obj with string rep to update. */
+{
+ register FsPath* fsPathPtr =
+ (FsPath*) objPtr->internalRep.otherValuePtr;
+ CONST char *cwdStr;
+ int cwdLen;
+ Tcl_Obj *copy;
+
+ if (fsPathPtr->flags == 0 || fsPathPtr->cwdPtr == NULL) {
+ panic("Called UpdateStringOfFsPath with invalid object");
+ }
+
+ copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
+ Tcl_IncrRefCount(copy);
+
+ cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
+ /*
+ * Should we perhaps use 'Tcl_FSPathSeparator'?
+ * But then what about the Windows special case?
+ * Perhaps we should just check if cwd is a root
+ * volume.
+ */
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ if (cwdStr[cwdLen-1] != '/') {
+ Tcl_AppendToObj(copy, "/", 1);
+ cwdLen++;
+ }
+ break;
+ case TCL_PLATFORM_WINDOWS:
+ /*
+ * We need the cwdLen > 2 because a volume
+ * relative path doesn't get a '/'. For
+ * example 'glob C:*cat*.exe' will return
+ * 'C:cat32.exe'
+ */
+ if (cwdStr[cwdLen-1] != '/'
+ && cwdStr[cwdLen-1] != '\\') {
+ if (cwdLen != 2 || cwdStr[1] != ':') {
+ Tcl_AppendToObj(copy, "/", 1);
+ cwdLen++;
+ }
+ }
+ break;
+ case TCL_PLATFORM_MAC:
+ if (cwdStr[cwdLen-1] != ':') {
+ Tcl_AppendToObj(copy, ":", 1);
+ cwdLen++;
+ }
+ break;
+ }
+
+ Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
+ objPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
+ objPtr->length = cwdLen;
+ copy->bytes = tclEmptyStringRep;
+ copy->length = 0;
+ Tcl_DecrRefCount(copy);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclNewFSPathObj --
+ *
+ * Creates a path object whose string representation is
+ * '[file join dirPtr addStrRep]', but does so in a way that
+ * allows for more efficient caching of normalized paths.
+ *
+ * Assumptions:
+ * 'dirPtr' must be an absolute path.
+ * 'len' may not be zero.
+ *
+ * Results:
+ * The new Tcl object.
+ *
+ * Side effects:
+ * Memory is allocated. 'dirPtr' gets an additional refCount.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len)
+{
+ FsPath *fsPathPtr;
+ Tcl_Obj *objPtr;
+
+ objPtr = Tcl_NewObj();
+ fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
+
+ /* Setup the path */
+ fsPathPtr->translatedPathPtr = NULL;
+ fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
+ Tcl_IncrRefCount(fsPathPtr->normPathPtr);
+ fsPathPtr->cwdPtr = dirPtr;
+ Tcl_IncrRefCount(dirPtr);
+ fsPathPtr->flags = TCLPATH_RELATIVE | TCLPATH_APPENDED;
+ fsPathPtr->nativePathPtr = NULL;
+ fsPathPtr->fsRecPtr = NULL;
+ fsPathPtr->filesystemEpoch = theFilesystemEpoch;
+
+ objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr;
+ objPtr->typePtr = &tclFsPathType;
+ objPtr->bytes = NULL;
+ objPtr->length = 0;
+ return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * MakeFsPathFromRelative --
+ *
+ * Like SetFsPathFromAny, but assumes the given object is an
+ * absolute normalized path. Only for internal use.
+ *
+ * Results:
+ * Standard Tcl error code.
+ *
+ * Side effects:
+ * The old representation may be freed, and new memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static Tcl_Obj*
+MakeFsPathFromRelative(interp, objPtr, cwdPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+ Tcl_Obj *cwdPtr; /* The object to convert. */
+{
+ FsPath *fsPathPtr;
+
+ if (objPtr->typePtr == &tclFsPathType) {
+ return TCL_OK;
+ }
+
+ /* Free old representation */
+ if (objPtr->typePtr != NULL) {
+ if (objPtr->bytes == NULL) {
+ if (objPtr->typePtr->updateStringProc == NULL) {
+ if (interp != NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "can't find object",
+ "string representation", (char *) NULL);
+ }
+ return NULL;
+ }
+ objPtr->typePtr->updateStringProc(objPtr);
+ }
+ if ((objPtr->typePtr->freeIntRepProc) != NULL) {
+ (*objPtr->typePtr->freeIntRepProc)(objPtr);
+ }
+ }
+
+ fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
+
+ /* Circular reference, by design */
+ fsPathPtr->translatedPathPtr = objPtr;
+ fsPathPtr->normPathPtr = NULL;
+ fsPathPtr->flags = 0;
+ fsPathPtr->cwdPtr = cwdPtr;
+ Tcl_IncrRefCount(cwdPtr);
+ fsPathPtr->nativePathPtr = NULL;
+ fsPathPtr->fsRecPtr = NULL;
+ fsPathPtr->filesystemEpoch = theFilesystemEpoch;
+
+ objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr;
+ objPtr->typePtr = &tclFsPathType;
+
+ return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* SetFsPathFromAbsoluteNormalized --
*
* Like SetFsPathFromAny, but assumes the given object is an
@@ -3870,6 +4147,7 @@ SetFsPathFromAbsoluteNormalized(interp, objPtr)
/* It's a pure normalized absolute path */
fsPathPtr->translatedPathPtr = NULL;
fsPathPtr->normPathPtr = objPtr;
+ fsPathPtr->flags = 0;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = NULL;
fsPathPtr->fsRecPtr = NULL;
@@ -4031,6 +4309,7 @@ SetFsPathFromAny(interp, objPtr)
fsPathPtr->translatedPathPtr = transPtr;
Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
fsPathPtr->normPathPtr = NULL;
+ fsPathPtr->flags = 0;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = NULL;
fsPathPtr->fsRecPtr = NULL;
@@ -4122,6 +4401,7 @@ Tcl_FSNewNativePath(fromFilesystem, clientData)
fsPathPtr->translatedPathPtr = NULL;
/* Circular reference, by design */
fsPathPtr->normPathPtr = objPtr;
+ fsPathPtr->flags = 0;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = clientData;
fsPathPtr->fsRecPtr = fsFromPtr;
@@ -4142,7 +4422,9 @@ FreeFsPathInternalRep(pathObjPtr)
(FsPath*) pathObjPtr->internalRep.otherValuePtr;
if (fsPathPtr->translatedPathPtr != NULL) {
- Tcl_DecrRefCount(fsPathPtr->translatedPathPtr);
+ if (fsPathPtr->translatedPathPtr != pathObjPtr) {
+ Tcl_DecrRefCount(fsPathPtr->translatedPathPtr);
+ }
}
if (fsPathPtr->normPathPtr != NULL) {
if (fsPathPtr->normPathPtr != pathObjPtr) {
@@ -4188,7 +4470,9 @@ DupFsPathInternalRep(srcPtr, copyPtr)
if (srcFsPathPtr->translatedPathPtr != NULL) {
copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
- Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
+ if (copyFsPathPtr->translatedPathPtr != copyPtr) {
+ Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
+ }
} else {
copyFsPathPtr->translatedPathPtr = NULL;
}
@@ -4209,6 +4493,8 @@ DupFsPathInternalRep(srcPtr, copyPtr)
copyFsPathPtr->cwdPtr = NULL;
}
+ copyFsPathPtr->flags = srcFsPathPtr->flags;
+
if (srcFsPathPtr->fsRecPtr != NULL
&& srcFsPathPtr->nativePathPtr != NULL) {
dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
@@ -4295,8 +4581,8 @@ Tcl_FSGetTranslatedPath(interp, pathPtr)
*/
CONST char*
Tcl_FSGetTranslatedStringPath(interp, pathPtr)
-Tcl_Interp *interp;
-Tcl_Obj* pathPtr;
+ Tcl_Interp *interp;
+ Tcl_Obj* pathPtr;
{
Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
if (transPtr == NULL) {
@@ -4330,18 +4616,156 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr)
Tcl_Interp *interp;
Tcl_Obj* pathObjPtr;
{
- register FsPath* srcFsPathPtr;
+ register FsPath* fsPathPtr;
if (Tcl_FSConvertToPathType(interp, pathObjPtr) != TCL_OK) {
return NULL;
}
- srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
- if (srcFsPathPtr->normPathPtr == NULL) {
+ fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
+
+ /* Ensure cwd hasn't changed */
+ if (fsPathPtr->flags != 0) {
+ Tcl_Obj *dir, *copy;
+ int dirLen;
+ int pathType;
+ CONST char *cwdStr;
+
+ pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
+ dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
+ if (dir == NULL) {
+ return NULL;
+ }
+ if (pathObjPtr->bytes == NULL) {
+ UpdateStringOfFsPath(pathObjPtr);
+ }
+ copy = Tcl_DuplicateObj(dir);
+ Tcl_IncrRefCount(copy);
+ Tcl_IncrRefCount(dir);
+ /* We now own a reference on both 'dir' and 'copy' */
+
+ cwdStr = Tcl_GetStringFromObj(copy,&dirLen);
+ /*
+ * Should we perhaps use 'Tcl_FSPathSeparator'?
+ * But then what about the Windows special case?
+ * Perhaps we should just check if cwd is a root
+ * volume.
+ */
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ if (cwdStr[dirLen-1] != '/') {
+ Tcl_AppendToObj(copy, "/", 1);
+ dirLen++;
+ }
+ break;
+ case TCL_PLATFORM_WINDOWS:
+ if (cwdStr[dirLen-1] != '/'
+ && cwdStr[dirLen-1] != '\\') {
+ Tcl_AppendToObj(copy, "/", 1);
+ dirLen++;
+ }
+ break;
+ case TCL_PLATFORM_MAC:
+ if (cwdStr[dirLen-1] != ':') {
+ Tcl_AppendToObj(copy, ":", 1);
+ dirLen++;
+ }
+ break;
+ }
+ Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
+ /*
+ * Normalize the combined string, but only starting after
+ * the end of the previously normalized 'dir'. This should
+ * be much faster! We use 'dirLen-1' so that we are
+ * already pointing at the dir-separator that we know about.
+ * The normalization code will actually start off directly
+ * after that separator.
+ */
+ TclNormalizeToUniquePath(interp, copy, dirLen-1);
+ /* Now we need to construct the new path object */
+
+ if (pathType == TCL_PATH_RELATIVE) {
+ register FsPath* origDirFsPathPtr;
+ Tcl_Obj *origDir = fsPathPtr->cwdPtr;
+ origDirFsPathPtr = (FsPath*) origDir->internalRep.otherValuePtr;
+
+ fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr;
+ Tcl_IncrRefCount(fsPathPtr->cwdPtr);
+
+ Tcl_DecrRefCount(fsPathPtr->normPathPtr);
+ fsPathPtr->normPathPtr = copy;
+ /* That's our reference to copy used */
+ Tcl_DecrRefCount(dir);
+ Tcl_DecrRefCount(origDir);
+ } else {
+ Tcl_DecrRefCount(fsPathPtr->cwdPtr);
+ fsPathPtr->cwdPtr = NULL;
+ Tcl_DecrRefCount(fsPathPtr->normPathPtr);
+ fsPathPtr->normPathPtr = copy;
+ /* That's our reference to copy used */
+ Tcl_DecrRefCount(dir);
+ }
+ fsPathPtr->flags = 0;
+ }
+ if (fsPathPtr->cwdPtr != NULL) {
+ if (!FsCwdPointerEquals(fsPathPtr->cwdPtr)) {
+ FreeFsPathInternalRep(pathObjPtr);
+ pathObjPtr->typePtr = NULL;
+ if (Tcl_ConvertToType(interp, pathObjPtr,
+ &tclFsPathType) != TCL_OK) {
+ return NULL;
+ }
+ fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
+ } else if (fsPathPtr->normPathPtr == NULL) {
+ int dirLen;
+ Tcl_Obj *copy;
+ CONST char *cwdStr;
+
+ copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
+ Tcl_IncrRefCount(copy);
+ cwdStr = Tcl_GetStringFromObj(copy,&dirLen);
+ /*
+ * Should we perhaps use 'Tcl_FSPathSeparator'?
+ * But then what about the Windows special case?
+ * Perhaps we should just check if cwd is a root
+ * volume.
+ */
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ if (cwdStr[dirLen-1] != '/') {
+ Tcl_AppendToObj(copy, "/", 1);
+ dirLen++;
+ }
+ break;
+ case TCL_PLATFORM_WINDOWS:
+ if (cwdStr[dirLen-1] != '/'
+ && cwdStr[dirLen-1] != '\\') {
+ Tcl_AppendToObj(copy, "/", 1);
+ dirLen++;
+ }
+ break;
+ case TCL_PLATFORM_MAC:
+ if (cwdStr[dirLen-1] != ':') {
+ Tcl_AppendToObj(copy, ":", 1);
+ dirLen++;
+ }
+ break;
+ }
+ Tcl_AppendObjToObj(copy, pathObjPtr);
+ /*
+ * Normalize the combined string, but only starting after
+ * the end of the previously normalized 'dir'. This should
+ * be much faster!
+ */
+ TclNormalizeToUniquePath(interp, copy, dirLen-1);
+ fsPathPtr->normPathPtr = copy;
+ }
+ }
+ if (fsPathPtr->normPathPtr == NULL) {
int relative = 0;
/*
* Since normPathPtr is NULL, but this is a valid path
* object, we know that the translatedPathPtr cannot be NULL.
*/
- Tcl_Obj *absolutePath = srcFsPathPtr->translatedPathPtr;
+ Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr;
char *path = Tcl_GetString(absolutePath);
/*
@@ -4365,19 +4789,19 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr)
relative = 1;
}
/* Already has refCount incremented */
- srcFsPathPtr->normPathPtr = FSNormalizeAbsolutePath(interp, absolutePath);
- if (!strcmp(Tcl_GetString(srcFsPathPtr->normPathPtr),
+ fsPathPtr->normPathPtr = FSNormalizeAbsolutePath(interp, absolutePath);
+ if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr),
Tcl_GetString(pathObjPtr))) {
/*
* The path was already normalized.
* Get rid of the duplicate.
*/
- Tcl_DecrRefCount(srcFsPathPtr->normPathPtr);
+ Tcl_DecrRefCount(fsPathPtr->normPathPtr);
/*
* We do *not* increment the refCount for
* this circular reference
*/
- srcFsPathPtr->normPathPtr = pathObjPtr;
+ fsPathPtr->normPathPtr = pathObjPtr;
}
if (relative) {
/* This was returned by Tcl_FSJoinToPath above */
@@ -4385,12 +4809,12 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr)
/* Get a quick, temporary lock on the cwd while we copy it */
Tcl_MutexLock(&cwdMutex);
- srcFsPathPtr->cwdPtr = cwdPathPtr;
- Tcl_IncrRefCount(srcFsPathPtr->cwdPtr);
+ fsPathPtr->cwdPtr = cwdPathPtr;
+ Tcl_IncrRefCount(fsPathPtr->cwdPtr);
Tcl_MutexUnlock(&cwdMutex);
}
}
- return srcFsPathPtr->normPathPtr;
+ return fsPathPtr->normPathPtr;
}
/*
@@ -4532,6 +4956,43 @@ Tcl_FSGetNativePath(pathObjPtr)
return (CONST char *)Tcl_FSGetInternalRep(pathObjPtr, &tclNativeFilesystem);
}
+static Tcl_Obj*
+FsGetValidObjRep(interp, objPtr)
+ Tcl_Interp *interp; /* Interpreter in which to store error
+ * message (if necessary). */
+ Tcl_Obj *objPtr; /* Object to convert to a valid, current
+ * path type. */
+{
+ FsPath *fsPathPtr;
+ if (objPtr->typePtr != &tclFsPathType) {
+ if (Tcl_ConvertToType(interp, objPtr, &tclFsPathType) != TCL_OK) {
+ return NULL;
+ }
+ }
+ fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr;
+
+ if (fsPathPtr->filesystemEpoch != theFilesystemEpoch) {
+ if (objPtr->bytes == NULL) {
+ UpdateStringOfFsPath(objPtr);
+ }
+ FreeFsPathInternalRep(objPtr);
+ objPtr->typePtr = NULL;
+ if (Tcl_ConvertToType(interp, objPtr, &tclFsPathType) != TCL_OK) {
+ return NULL;
+ }
+ fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr;
+ }
+
+ if (fsPathPtr->cwdPtr != NULL) {
+ if (FsCwdPointerEquals(fsPathPtr->cwdPtr)) {
+ /* This causes a few minor test failures with links */
+ /* Once these are resolved, this would improve efficiency */
+ /* return objPtr; */
+ }
+ }
+ return Tcl_FSGetNormalizedPath(interp, objPtr);
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -4553,31 +5014,27 @@ NativeCreateNativeRep(pathObjPtr)
{
char *nativePathPtr;
Tcl_DString ds;
- Tcl_Obj* normPtr;
+ Tcl_Obj* validPathObjPtr;
int len;
char *str;
/* Make sure the normalized path is set */
- normPtr = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
+ validPathObjPtr = FsGetValidObjRep(NULL, pathObjPtr);
- str = Tcl_GetStringFromObj(normPtr,&len);
+ str = Tcl_GetStringFromObj(validPathObjPtr, &len);
#ifdef __WIN32__
Tcl_WinUtfToTChar(str, len, &ds);
if (tclWinProcs->useWide) {
- nativePathPtr = ckalloc((unsigned)(sizeof(WCHAR)+Tcl_DStringLength(&ds)));
- memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds),
- (size_t) (sizeof(WCHAR)+Tcl_DStringLength(&ds)));
+ len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
} else {
- nativePathPtr = ckalloc((unsigned)(sizeof(char)+Tcl_DStringLength(&ds)));
- memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds),
- (size_t) (sizeof(char)+Tcl_DStringLength(&ds)));
+ len = Tcl_DStringLength(&ds) + sizeof(char);
}
#else
Tcl_UtfToExternalDString(NULL, str, len, &ds);
- nativePathPtr = ckalloc((unsigned)(sizeof(char)+Tcl_DStringLength(&ds)));
- memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds),
- (size_t) (sizeof(char)+Tcl_DStringLength(&ds)));
+ len = Tcl_DStringLength(&ds) + sizeof(char);
#endif
+ nativePathPtr = ckalloc((unsigned) len);
+ memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len);
Tcl_DStringFree(&ds);
return (ClientData)nativePathPtr;
@@ -5021,12 +5478,15 @@ Tcl_FSEqualPaths(firstPtr, secondPtr)
if (firstPtr == secondPtr) {
return 1;
} else {
- int tempErrno;
+ char *firstStr, *secondStr;
+ int firstLen, secondLen, tempErrno;
if (firstPtr == NULL || secondPtr == NULL) {
return 0;
}
- if (!(strcmp(Tcl_GetString(firstPtr), Tcl_GetString(secondPtr)))) {
+ firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
+ secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
+ if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
return 1;
}
/*
@@ -5042,7 +5502,9 @@ Tcl_FSEqualPaths(firstPtr, secondPtr)
if (firstPtr == NULL || secondPtr == NULL) {
return 0;
}
- if (!(strcmp(Tcl_GetString(firstPtr), Tcl_GetString(secondPtr)))) {
+ firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
+ secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
+ if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
return 1;
}
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index eff764b..aea1f4f 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.117 2003/02/04 17:06:50 vincentdarley Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.118 2003/02/10 10:26:25 vincentdarley Exp $
*/
#ifndef _TCLINT
@@ -1717,6 +1717,8 @@ EXTERN int TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr,
Tcl_StatBuf *buf));
EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void));
EXTERN Tcl_Obj* TclpTempFileName _ANSI_ARGS_((void));
+EXTERN Tcl_Obj* TclNewFSPathObj _ANSI_ARGS_((Tcl_Obj *dirPtr,
+ CONST char *addStrRep, int len));
EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char *path));
EXTERN void TclpFinalizeCondition _ANSI_ARGS_((
Tcl_Condition *condPtr));