Attachment "fs3-682500.diff" to
ticket [682500ffff]
added by
hobbs
2003-02-11 09:08:58.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.1399
retrieving revision 1.1402
diff -u -r1.1399 -r1.1402
--- ChangeLog 8 Feb 2003 22:03:19 -0000 1.1399
+++ ChangeLog 10 Feb 2003 13:32:23 -0000 1.1402
@@ -1,3 +1,30 @@
+2003-02-10 Vince Darley <[email protected]>
+
+ * doc/FileSystem.3:
+ * generic/tclIOUtil.c:
+ * generic/tclInt.h:
+ * tests/fileSystem.test:
+ * unix/tclUnixFCmd.c:
+ * unix/tclUnixFile.c:
+ * win/tclWinFile.c: further filesystem optimization, applying
+ [Patch 682500]. In particular, these code examples are
+ faster now:
+
+ foreach f $flist { if {[file exists $f]} {file stat $f arr;...}}
+
+ foreach f [glob -dir $dir *] { # action and/or recursion on $f }
+
+ cd $dir
+ foreach f [glob *] { # action and/or recursion on $f }
+ cd ..
+
+ * generic/tclTest.c: Fix for [Bug 683181] where test suite
+ left files in 'tmp'.
+
2003-02-08 Jeff Hobbs <[email protected]>
* library/safe.tcl: code cleanup of eval and string comp use.
Index: doc/FileSystem.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/FileSystem.3,v
retrieving revision 1.30
retrieving revision 1.32
diff -u -r1.30 -r1.32
--- doc/FileSystem.3 22 Jul 2002 16:51:47 -0000 1.30
+++ doc/FileSystem.3 10 Feb 2003 12:50:31 -0000 1.32
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: FileSystem.3,v 1.30 2002/07/22 16:51:47 vincentdarley Exp $
+'\" RCS: @(#) $Id: FileSystem.3,v 1.32 2003/02/10 12:50:31 vincentdarley Exp $
'\"
.so man.macros
.TH Filesystem 3 8.4 Tcl "Tcl Library Procedures"
@@ -856,6 +856,12 @@
components should be converted from symbolic links. This one
exception is required to agree with Tcl's semantics with 'file
delete', 'file rename', 'file copy' operating on symbolic links.
+This function may be called with 'nextCheckpoint' either
+at the beginning of the path (i.e. zero), at the end of the path, or
+at any intermediate file separator in the path. It will never
+point to any other arbitrary position in the path. In the last of
+the three valid cases, the implementation can assume that the path
+up to and including the file separator is known and normalized.
.PP
.CS
typedef int Tcl_FSNormalizePathProc(
@@ -997,15 +1003,17 @@
Tcl_GlobTypeData * \fItypes\fR);
.CE
.PP
-The function should return all files or directories (or other
-filesystem objects) which match the given pattern and accord with the
-\fItypes\fR specification given. There are two ways in which this
-function may be called. If \fIpattern\fR is NULL, then \fIpathPtr\fR
-is a full path specification of a single file or directory which
-should be checked for existence and correct type. Otherwise, \fIpathPtr\fR
-is a directory, the contents of which the function should search for
-files or directories which have the correct type. In either case,
-\fIpathPtr\fR can be assumed to be both non-NULL and non-empty.
+The function should return all files or directories (or other filesystem
+objects) which match the given pattern and accord with the \fItypes\fR
+specification given. There are two ways in which this function may be
+called. If \fIpattern\fR is NULL, then \fIpathPtr\fR is a full path
+specification of a single file or directory which should be checked for
+existence and correct type. Otherwise, \fIpathPtr\fR is a directory, the
+contents of which the function should search for files or directories
+which have the correct type. In either case, \fIpathPtr\fR can be
+assumed to be both non-NULL and non-empty. It is not currently
+documented whether \fIpathPtr\fR will have a file separator at its end of
+not, so code should be flexible to both possibilities.
.PP
The return value is a standard Tcl result indicating whether an error
occurred in the matching process. Error messages are placed in interp,
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.71
retrieving revision 1.73
diff -u -r1.71 -r1.73
--- generic/tclIOUtil.c 4 Feb 2003 17:06:50 -0000 1.71
+++ generic/tclIOUtil.c 10 Feb 2003 12:50:31 -0000 1.73
@@ -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.73 2003/02/10 12:50:31 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 @@
"path", /* name */
FreeFsPathInternalRep, /* freeIntRepProc */
DupFsPathInternalRep, /* dupIntRepProc */
- NULL, /* updateStringProc */
+ UpdateStringOfFsPath, /* updateStringProc */
SetFsPathFromAny /* setFromAnyProc */
};
@@ -495,7 +499,8 @@
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 @@
* 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 @@
*/
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 @@
*/
void
-TclResetFilesystem() {
+TclResetFilesystem()
+{
filesystemList = &nativeFilesystemRecord;
/*
* Note, at this point, I believe nativeFilesystemRecord ->
@@ -996,9 +1005,11 @@
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 @@
* 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 @@
* 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 @@
* 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 @@
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 @@
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 @@
}
FsReleaseIterator();
- return (retVal);
+ return (startAt);
}
/*
@@ -1540,16 +1555,8 @@
{
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_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_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_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 @@
* 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 @@
*
* 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_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 @@
* 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 @@
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 @@
} 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 @@
* 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 @@
}
/*
* 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 @@
*
*---------------------------------------------------------------------------
*/
-
int
Tcl_FSConvertToPathType(interp, objPtr)
Tcl_Interp *interp; /* Interpreter in which to store error
@@ -3766,10 +3847,14 @@
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,197 @@
/*
*---------------------------------------------------------------------------
*
+ * 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 extra 'cwdLen != 2', and ':' checks 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 +4146,7 @@
/* 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 +4308,7 @@
fsPathPtr->translatedPathPtr = transPtr;
Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
fsPathPtr->normPathPtr = NULL;
+ fsPathPtr->flags = 0;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = NULL;
fsPathPtr->fsRecPtr = NULL;
@@ -4122,6 +4400,7 @@
fsPathPtr->translatedPathPtr = NULL;
/* Circular reference, by design */
fsPathPtr->normPathPtr = objPtr;
+ fsPathPtr->flags = 0;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = clientData;
fsPathPtr->fsRecPtr = fsFromPtr;
@@ -4142,7 +4421,9 @@
(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 +4469,9 @@
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 +4492,8 @@
copyFsPathPtr->cwdPtr = NULL;
}
+ copyFsPathPtr->flags = srcFsPathPtr->flags;
+
if (srcFsPathPtr->fsRecPtr != NULL
&& srcFsPathPtr->nativePathPtr != NULL) {
dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
@@ -4261,6 +4546,9 @@
}
srcFsPathPtr = (FsPath*) pathPtr->internalRep.otherValuePtr;
if (srcFsPathPtr->translatedPathPtr == NULL) {
+ if (srcFsPathPtr->flags != 0) {
+ return Tcl_FSGetNormalizedPath(interp, pathPtr);
+ }
/*
* It is a pure absolute, normalized path object.
* This is something like being a 'pure list'. The
@@ -4295,8 +4583,8 @@
*/
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 +4618,156 @@
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 +4791,19 @@
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 +4811,12 @@
/* 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;
}
/*
@@ -4553,31 +4979,27 @@
{
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 = Tcl_FSGetNormalizedPath(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 +5443,15 @@
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 +5467,9 @@
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;
}
}
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.117
retrieving revision 1.118
diff -u -r1.117 -r1.118
--- generic/tclInt.h 4 Feb 2003 17:06:50 -0000 1.117
+++ generic/tclInt.h 10 Feb 2003 10:26:25 -0000 1.118
@@ -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 @@
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));
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -r1.59 -r1.60
--- generic/tclTest.c 7 Feb 2003 11:59:43 -0000 1.59
+++ generic/tclTest.c 10 Feb 2003 12:50:31 -0000 1.60
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTest.c,v 1.59 2003/02/07 11:59:43 vincentdarley Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.60 2003/02/10 12:50:31 vincentdarley Exp $
*/
#define TCL_TEST
@@ -6041,6 +6041,8 @@
* copy without an interp
*/
static Tcl_Interp *simpleInterpPtr = NULL;
+/* We use this to ensure we clean up after ourselves */
+static Tcl_Obj *tempFile = NULL;
/*
* This is a very 'hacky' filesystem which is used just so
@@ -6085,6 +6087,11 @@
msg = (res == TCL_OK) ? "registered" : "failed";
simpleInterpPtr = interp;
} else {
+ if (tempFile != NULL) {
+ Tcl_FSDeleteFile(tempFile);
+ Tcl_DecrRefCount(tempFile);
+ tempFile = NULL;
+ }
res = Tcl_FSUnregister(&simpleFilesystem);
msg = (res == TCL_OK) ? "unregistered" : "failed";
simpleInterpPtr = NULL;
@@ -6121,6 +6128,7 @@
Tcl_DecrRefCount(origPtr);
if (res != TCL_OK) {
+ Tcl_FSDeleteFile(tempPtr);
Tcl_DecrRefCount(tempPtr);
return NULL;
}
@@ -6153,8 +6161,12 @@
}
chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions);
-
- Tcl_DecrRefCount(tempPtr);
+ /* When we are done with this file, it will never be deleted */
+ if (tempFile != NULL) {
+ Tcl_FSDeleteFile(tempFile);
+ Tcl_DecrRefCount(tempFile);
+ }
+ tempFile = tempPtr;
return chan;
}
@@ -6179,6 +6191,7 @@
return TCL_OK;
} else {
int res = Tcl_FSStat(tempPtr, bufPtr);
+ Tcl_FSDeleteFile(tempPtr);
Tcl_DecrRefCount(tempPtr);
return res;
}
Index: tests/fileSystem.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/fileSystem.test,v
retrieving revision 1.19
diff -u -r1.19 fileSystem.test
--- tests/fileSystem.test 7 Feb 2003 15:29:32 -0000 1.19
+++ tests/fileSystem.test 11 Feb 2003 01:56:57 -0000
@@ -423,7 +423,6 @@
test filesystem-8.1 {relative path objects and caching of pwd} {
set dir [pwd]
cd [tcltest::temporaryDirectory]
- # We created this file several tests ago.
makeDirectory abc
makeDirectory def
makeFile "contents" [file join abc foo]
@@ -444,6 +443,32 @@
cd $dir
set res
} {1 1 0 0}
+
+test filesystem-8.2 {relative path objects and use of pwd} {
+ set origdir [pwd]
+ cd [tcltest::temporaryDirectory]
+ set dir "abc"
+ makeDirectory $dir
+ makeFile "contents" [file join abc foo]
+ cd $dir
+ set res [file exists [lindex [glob *] 0]]
+ cd ..
+ removeFile [file join abc foo]
+ removeDirectory abc
+ removeDirectory def
+ cd $origdir
+ set res
+} {1}
+
+test filesystem-9.1 {path objects and empty string} {
+ set anchor ""
+ set dst foo
+ set res $dst
+
+ set yyy [file split $anchor] ; # (*)
+ set dst [file join $anchor $dst]
+ lappend res $dst
+} {foo foo}
cleanupTests
}
Index: unix/tclUnixFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFCmd.c,v
retrieving revision 1.26
retrieving revision 1.28
diff -u -r1.26 -r1.28
--- unix/tclUnixFCmd.c 4 Feb 2003 17:06:52 -0000 1.26
+++ unix/tclUnixFCmd.c 10 Feb 2003 12:50:31 -0000 1.28
@@ -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.26 2003/02/04 17:06:52 vincentdarley Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.28 2003/02/10 12:50:31 vincentdarley Exp $
*
* Portions of this code were derived from NetBSD source code which has
* the following copyright notice:
@@ -839,8 +839,9 @@
}
while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */
- if ((strcmp(dirEntPtr->d_name, ".") == 0)
- || (strcmp(dirEntPtr->d_name, "..") == 0)) {
+ if ((dirEntPtr->d_name[0] == '.')
+ && ((dirEntPtr->d_name[1] == '\0')
+ || (strcmp(dirEntPtr->d_name, "..") == 0))) {
continue;
}
@@ -1652,7 +1653,6 @@
*
*---------------------------------------------------------------------------
*/
-
int
TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
Tcl_Interp *interp;
@@ -1668,9 +1668,32 @@
Tcl_DString ds;
CONST char *nativePath;
#endif
-
+ /*
+ * We add '1' here because if nextCheckpoint is zero we know
+ * that '/' exists, and if it isn't zero, it must point at
+ * a directory separator which we also know exists.
+ */
currentPathEndPosition = path + nextCheckpoint;
+ if (*currentPathEndPosition == '/') {
+ currentPathEndPosition++;
+ }
+#ifndef NO_REALPATH
+ /* For speed, try to get the entire path in one go */
+ if (nextCheckpoint == 0) {
+ char *lastDir = strrchr(currentPathEndPosition, '/');
+ if (lastDir != NULL) {
+ nativePath = Tcl_UtfToExternalDString(NULL, path,
+ lastDir - path, &ds);
+ if (Realpath(nativePath, normPath) != NULL) {
+ nextCheckpoint = lastDir - path;
+ goto wholeStringOk;
+ }
+ }
+ }
+ /* Else do it the slow way */
+#endif
+
while (1) {
cur = *currentPathEndPosition;
if ((cur == '/') && (path != currentPathEndPosition)) {
@@ -1713,12 +1736,25 @@
nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds);
if (Realpath(nativePath, normPath) != NULL) {
+ int newNormLen;
+ wholeStringOk:
+ newNormLen = strlen(normPath);
+ if ((newNormLen == Tcl_DStringLength(&ds))
+ && (strcmp(normPath, nativePath) == 0)) {
+ /* String is unchanged */
+ Tcl_DStringFree(&ds);
+ if (path[nextCheckpoint] != '\0') {
+ nextCheckpoint++;
+ }
+ return nextCheckpoint;
+ }
+
/*
* Free up the native path and put in its place the
* converted, normalized path.
*/
Tcl_DStringFree(&ds);
- Tcl_ExternalToUtfDString(NULL, normPath, (int) strlen(normPath), &ds);
+ Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds);
if (path[nextCheckpoint] != '\0') {
/* not at end, append remaining path */
@@ -1745,3 +1781,6 @@
return nextCheckpoint;
}
+
+
+
Index: unix/tclUnixFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFile.c,v
retrieving revision 1.29
diff -u -r1.29 tclUnixFile.c
--- unix/tclUnixFile.c 9 Jan 2003 10:38:34 -0000 1.29
+++ unix/tclUnixFile.c 11 Feb 2003 01:56:57 -0000
@@ -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.29 2003/01/09 10:38:34 vincentdarley Exp $
+ * RCS: @(#) $Id: tclUnixFile.c,v 1.30 2003/02/10 10:26:26 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -217,25 +217,25 @@
if (pattern == NULL || (*pattern == '\0')) {
/* Match a file directly */
- CONST char *native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
+ native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
if (NativeMatchType(native, types)) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
}
return TCL_OK;
} else {
- CONST char *fname, *dirName;
DIR *d;
- Tcl_DString ds;
- Tcl_StatBuf statBuf;
+ Tcl_DirEntry *entryPtr;
+ CONST char *dirName;
+ int dirLength;
int matchHidden;
int nativeDirLen;
- int result = TCL_OK;
- Tcl_DString dsOrig;
- int baseLength;
-
+ Tcl_StatBuf statBuf;
+ Tcl_DString ds; /* native encoding of dir */
+ Tcl_DString dsOrig; /* utf-8 encoding of dir */
+
Tcl_DStringInit(&dsOrig);
- Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
- baseLength = Tcl_DStringLength(&dsOrig);
+ dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
+ Tcl_DStringAppend(&dsOrig, dirName, dirLength);
/*
* Make sure that the directory part of the name really is a
@@ -245,27 +245,16 @@
* otherwise "glob foo.c" would return "./foo.c".
*/
- if (baseLength == 0) {
+ if (dirLength == 0) {
dirName = ".";
} else {
dirName = Tcl_DStringValue(&dsOrig);
/* Make sure we have a trailing directory delimiter */
- if (dirName[baseLength-1] != '/') {
+ if (dirName[dirLength-1] != '/') {
dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
- baseLength++;
+ dirLength++;
}
}
-
- /*
- * Check to see if the pattern needs to compare with hidden files.
- */
-
- if ((pattern[0] == '.')
- || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
- matchHidden = 1;
- } else {
- matchHidden = 0;
- }
/*
* Now open the directory for reading and iterate over the contents.
@@ -282,55 +271,36 @@
d = opendir(native); /* INTL: Native. */
if (d == NULL) {
- char savedChar = '\0';
- Tcl_ResetResult(interp);
Tcl_DStringFree(&ds);
-
- /*
- * Strip off a trailing '/' if necessary, before reporting the error.
- */
-
- if (baseLength > 0) {
- savedChar = (Tcl_DStringValue(&dsOrig))[baseLength-1];
- if (savedChar == '/') {
- (Tcl_DStringValue(&dsOrig))[baseLength-1] = '\0';
- }
- }
+ Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't read directory \"",
Tcl_DStringValue(&dsOrig), "\": ",
Tcl_PosixError(interp), (char *) NULL);
- if (baseLength > 0) {
- (Tcl_DStringValue(&dsOrig))[baseLength-1] = savedChar;
- }
Tcl_DStringFree(&dsOrig);
return TCL_ERROR;
}
nativeDirLen = Tcl_DStringLength(&ds);
- while (1) {
+ /*
+ * Check to see if -type or the pattern requests hidden files.
+ */
+ matchHidden = ((types && (types->perm & TCL_GLOB_PERM_HIDDEN)) ||
+ ((pattern[0] == '.')
+ || ((pattern[0] == '\\') && (pattern[1] == '.'))));
+
+ while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */
Tcl_DString utfDs;
- CONST char *utf;
- Tcl_DirEntry *entryPtr;
-
- entryPtr = TclOSreaddir(d); /* INTL: Native. */
- if (entryPtr == NULL) {
- break;
- }
- if (types != NULL && (types->perm & TCL_GLOB_PERM_HIDDEN)) {
- /*
- * We explicitly asked for hidden files, so turn around
- * and ignore any file which isn't hidden.
- */
- if (*entryPtr->d_name != '.') {
- continue;
- }
- } else if (!matchHidden && (*entryPtr->d_name == '.')) {
- /*
- * Don't match names starting with "." unless the "." is
- * present in the pattern.
- */
- continue;
+ CONST char *utfname;
+
+ /*
+ * Skip this file if it doesn't agree with the hidden
+ * parameters requested by the user (via -type or pattern).
+ */
+ if (*entryPtr->d_name == '.') {
+ if (!matchHidden) continue;
+ } else {
+ if (matchHidden) continue;
}
/*
@@ -338,22 +308,20 @@
* and pattern. If so, add the file to the result.
*/
- utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &utfDs);
- if (Tcl_StringMatch(utf, pattern) != 0) {
+ utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name,
+ -1, &utfDs);
+ if (Tcl_StringCaseMatch(utfname, pattern, 0)) {
int typeOk = 1;
- Tcl_DStringSetLength(&dsOrig, baseLength);
- Tcl_DStringAppend(&dsOrig, utf, -1);
- fname = Tcl_DStringValue(&dsOrig);
if (types != NULL) {
- char *nativeEntry;
Tcl_DStringSetLength(&ds, nativeDirLen);
- nativeEntry = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
- typeOk = NativeMatchType(nativeEntry, types);
+ native = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
+ typeOk = NativeMatchType(native, types);
}
if (typeOk) {
Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
+ TclNewFSPathObj(pathPtr, utfname,
+ Tcl_DStringLength(&utfDs)));
}
}
Tcl_DStringFree(&utfDs);
@@ -362,7 +330,7 @@
closedir(d);
Tcl_DStringFree(&ds);
Tcl_DStringFree(&dsOrig);
- return result;
+ return TCL_OK;
}
}
static int
Index: win/tclWinFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinFile.c,v
retrieving revision 1.42
retrieving revision 1.44
diff -u -r1.42 -r1.44
--- win/tclWinFile.c 7 Feb 2003 15:29:34 -0000 1.42
+++ win/tclWinFile.c 10 Feb 2003 12:50:32 -0000 1.44
@@ -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.42 2003/02/07 15:29:34 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.44 2003/02/10 12:50:32 vincentdarley Exp $
*/
//#define _WIN32_WINNT 0x0500
@@ -667,7 +667,7 @@
* May be NULL. In particular the directory
* flag is very important. */
{
- CONST TCHAR *nativeName;
+ CONST TCHAR *native;
if (pattern == NULL || (*pattern == '\0')) {
Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
@@ -677,43 +677,39 @@
DWORD attr;
CONST char *str = Tcl_GetStringFromObj(norm,&len);
- nativeName = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr);
+ native = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr);
if (tclWinProcs->getFileAttributesExProc == NULL) {
- attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ attr = (*tclWinProcs->getFileAttributesProc)(native);
if (attr == 0xffffffff) {
return TCL_OK;
}
} else {
WIN32_FILE_ATTRIBUTE_DATA data;
- if((*tclWinProcs->getFileAttributesExProc)(nativeName,
- GetFileExInfoStandard,
- &data) != TRUE) {
+ if ((*tclWinProcs->getFileAttributesExProc)(native,
+ GetFileExInfoStandard, &data) != TRUE) {
return TCL_OK;
}
attr = data.dwFileAttributes;
}
if (NativeMatchType(WinIsDrive(str,len), attr,
- nativeName, types)) {
+ native, types)) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
}
}
return TCL_OK;
} else {
- char drivePat[] = "?:\\";
- const char *message;
- CONST char *dir;
- int dirLength;
- Tcl_DString dirString;
DWORD attr;
HANDLE handle;
WIN32_FIND_DATAT data;
- BOOL found;
- Tcl_DString ds;
- Tcl_DString dsOrig;
- Tcl_Obj *fileNamePtr;
+ CONST char *dirName;
+ int dirLength;
int matchSpecialDots;
-
+ Tcl_DString ds; /* native encoding of dir */
+ Tcl_DString dsOrig; /* utf-8 encoding of dir */
+ Tcl_DString dirString; /* utf-8 encoding of dir with \'s */
+ Tcl_Obj *fileNamePtr;
+
/*
* Convert the path to normalized form since some interfaces only
* accept backslashes. Also, ensure that the directory ends with a
@@ -725,9 +721,8 @@
return TCL_ERROR;
}
Tcl_DStringInit(&dsOrig);
- Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
-
- dirLength = Tcl_DStringLength(&dsOrig);
+ dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
+ Tcl_DStringAppend(&dsOrig, dirName, dirLength);
Tcl_DStringInit(&dirString);
if (dirLength == 0) {
@@ -735,8 +730,7 @@
} else {
char *p;
- Tcl_DStringAppend(&dirString, Tcl_DStringValue(&dsOrig),
- Tcl_DStringLength(&dsOrig));
+ Tcl_DStringAppend(&dirString, dirName, dirLength);
for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
if (*p == '/') {
*p = '\\';
@@ -750,14 +744,15 @@
dirLength++;
}
}
- dir = Tcl_DStringValue(&dirString);
+ dirName = Tcl_DStringValue(&dirString);
/*
* First verify that the specified path is actually a directory.
*/
- nativeName = Tcl_WinUtfToTChar(dir, Tcl_DStringLength(&dirString), &ds);
- attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ native = Tcl_WinUtfToTChar(dirName, Tcl_DStringLength(&dirString),
+ &ds);
+ attr = (*tclWinProcs->getFileAttributesProc)(native);
Tcl_DStringFree(&ds);
if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
@@ -766,6 +761,27 @@
}
/*
+ * We need to check all files in the directory, so append a *.*
+ * to the path.
+ */
+
+ dirName = Tcl_DStringAppend(&dirString, "*.*", 3);
+ native = Tcl_WinUtfToTChar(dirName, -1, &ds);
+ handle = (*tclWinProcs->findFirstFileProc)(native, &data);
+ Tcl_DStringFree(&ds);
+
+ if (handle == INVALID_HANDLE_VALUE) {
+ Tcl_DStringFree(&dirString);
+ TclWinConvertError(GetLastError());
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't read directory \"",
+ Tcl_DStringValue(&dsOrig), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ Tcl_DStringFree(&dsOrig);
+ return TCL_ERROR;
+ }
+
+ /*
* Check to see if the pattern should match the special
* . and .. names, referring to the current directory,
* or the directory above. We need a special check for
@@ -782,59 +798,40 @@
}
/*
- * We need to check all files in the directory, so append a *.*
- * to the path.
+ * Now iterate over all of the files in the directory, starting
+ * with the first one we found.
*/
- dir = Tcl_DStringAppend(&dirString, "*.*", 3);
- nativeName = Tcl_WinUtfToTChar(dir, -1, &ds);
- handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
- Tcl_DStringFree(&ds);
-
- if (handle == INVALID_HANDLE_VALUE) {
- message = "couldn't read directory \"";
- goto error;
- }
-
- /*
- * Now iterate over all of the files in the directory.
- */
-
- for (found = 1; found != 0;
- found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
- CONST char *name, *fullname;
+ do {
+ CONST char *utfname;
int checkDrive = 0;
int isDrive;
DWORD attr;
if (tclWinProcs->useWide) {
- nativeName = (CONST TCHAR *) data.w.cFileName;
+ native = (CONST TCHAR *) data.w.cFileName;
attr = data.w.dwFileAttributes;
} else {
- nativeName = (CONST TCHAR *) data.a.cFileName;
+ native = (CONST TCHAR *) data.a.cFileName;
attr = data.a.dwFileAttributes;
}
- name = Tcl_WinTCharToUtf(nativeName, -1, &ds);
+ utfname = Tcl_WinTCharToUtf(native, -1, &ds);
if (!matchSpecialDots) {
/* If it is exactly '.' or '..' then we ignore it */
- if (name[0] == '.') {
- if (name[1] == '\0'
- || (name[1] == '.' && name[2] == '\0')) {
- Tcl_DStringFree(&ds);
- continue;
- }
- }
- } else {
- if (name[0] == '.' && name[1] == '.' && name[2] == '\0') {
- /*
- * Have to check if this is a drive below, so
- * we can correctly match 'hidden' and not hidden
- * files.
- */
- checkDrive = 1;
+ if ((utfname[0] == '.') && (utfname[1] == '\0'
+ || (utfname[1] == '.' && utfname[2] == '\0'))) {
+ Tcl_DStringFree(&ds);
+ continue;
}
+ } else if (utfname[0] == '.' && utfname[1] == '.'
+ && utfname[2] == '\0') {
+ /*
+ * Have to check if this is a drive below, so we can
+ * correctly match 'hidden' and not hidden files.
+ */
+ checkDrive = 1;
}
/*
@@ -849,57 +846,38 @@
* the system.
*/
- if (Tcl_StringCaseMatch(name, pattern, 1) == 0) {
- Tcl_DStringFree(&ds);
- continue;
- }
-
- /*
- * If the file matches, then we need to process the remainder
- * of the path.
- */
-
- Tcl_DStringAppend(&dsOrig, name, -1);
- Tcl_DStringFree(&ds);
+ if (Tcl_StringCaseMatch(utfname, pattern, 1)) {
+ /*
+ * If the file matches, then we need to process the remainder
+ * of the path.
+ */
- fullname = Tcl_DStringValue(&dsOrig);
- nativeName = Tcl_WinUtfToTChar(fullname,
- Tcl_DStringLength(&dsOrig), &ds);
-
- if (checkDrive) {
- isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));
- } else {
- isDrive = 0;
- }
- if (NativeMatchType(isDrive, attr, nativeName, types)) {
- Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(fullname, Tcl_DStringLength(&dsOrig)));
+ if (checkDrive) {
+ CONST char *fullname = Tcl_DStringAppend(&dsOrig, utfname,
+ Tcl_DStringLength(&ds));
+ isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));
+ Tcl_DStringSetLength(&dsOrig, dirLength);
+ } else {
+ isDrive = 0;
+ }
+ if (NativeMatchType(isDrive, attr, native, types)) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ TclNewFSPathObj(pathPtr, utfname,
+ Tcl_DStringLength(&ds)));
+ }
}
+
/*
- * Free ds here to ensure that nativeName is valid above.
+ * Free ds here to ensure that native is valid above.
*/
-
Tcl_DStringFree(&ds);
-
- Tcl_DStringSetLength(&dsOrig, dirLength);
- }
+ } while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE);
FindClose(handle);
Tcl_DStringFree(&dirString);
Tcl_DStringFree(&dsOrig);
-
return TCL_OK;
-
- error:
- Tcl_DStringFree(&dirString);
- TclWinConvertError(GetLastError());
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, message, Tcl_DStringValue(&dsOrig), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- Tcl_DStringFree(&dsOrig);
- return TCL_ERROR;
}
-
}
/*
@@ -999,7 +977,7 @@
if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
/* If invisible */
if ((types->perm == 0) ||
- !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
+ !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
return 0;
}
} else {
@@ -2048,6 +2026,9 @@
Tcl_DString ds;
currentPathEndPosition = path + nextCheckpoint;
+ if (*currentPathEndPosition == '/') {
+ currentPathEndPosition++;
+ }
while (1) {
char cur = *currentPathEndPosition;
if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
@@ -2117,6 +2098,9 @@
Tcl_DString ds;
currentPathEndPosition = path + nextCheckpoint;
+ if (*currentPathEndPosition == '/') {
+ currentPathEndPosition++;
+ }
while (1) {
char cur = *currentPathEndPosition;
if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
