From 850d398c1a0776e72d591c406090dfaca8492aeb Mon Sep 17 00:00:00 2001 From: vincentdarley Date: Mon, 10 Feb 2003 10:26:20 +0000 Subject: filesystem speed up round 2 --- ChangeLog | 20 ++ doc/FileSystem.3 | 22 +- generic/tclIOUtil.c | 680 ++++++++++++++++++++++++++++++++++++++++++-------- generic/tclInt.h | 4 +- tests/fileSystem.test | 17 +- unix/tclUnixFCmd.c | 50 +++- unix/tclUnixFile.c | 94 +++---- win/tclWinFile.c | 189 +++++++------- 8 files changed, 785 insertions(+), 291 deletions(-) diff --git a/ChangeLog b/ChangeLog index c2e1ed8..c195cc4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,23 @@ +2003-02-10 Vince Darley + + * 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 .. + 2003-02-08 Jeff Hobbs * library/safe.tcl: code cleanup of eval and string comp use. diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index 2af7768..47a6dd5 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -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.31 2003/02/10 10:26:24 vincentdarley Exp $ '\" .so man.macros .TH Filesystem 3 8.4 Tcl "Tcl Library Procedures" @@ -997,15 +997,17 @@ typedef int Tcl_FSMatchInDirectoryProc( 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, 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)); diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 37a0666..dfb42bb 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -423,7 +423,6 @@ removeFile gorp.file 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] @@ -445,6 +444,22 @@ test filesystem-8.1 {relative path objects and caching of pwd} { 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} + cleanupTests } namespace delete ::tcl::test::fileSystem diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 5a9525f..a5b6792 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFCmd.c,v 1.26 2003/02/04 17:06:52 vincentdarley Exp $ + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.27 2003/02/10 10:26:26 vincentdarley Exp $ * * Portions of this code were derived from NetBSD source code which has * the following copyright notice: @@ -839,8 +839,9 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr) } 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 @@ GetModeFromPermString(interp, modeStringPtr, modePtr) * *--------------------------------------------------------------------------- */ - int TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) Tcl_Interp *interp; @@ -1668,9 +1668,29 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) 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 + 1; - currentPathEndPosition = path + nextCheckpoint; - +#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 +1733,25 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) 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 +1778,6 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) return nextCheckpoint; } + + + diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 2dacb64..62f9a3a 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFile.c,v 1.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 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) 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 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) * 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,41 +271,32 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) 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 the pattern needs to compare with hidden files. + */ + + if ((pattern[0] == '.') + || ((pattern[0] == '\\') && (pattern[1] == '.'))) { + matchHidden = 1; + } else { + matchHidden = 0; + } + + while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */ Tcl_DString utfDs; - CONST char *utf; - Tcl_DirEntry *entryPtr; + CONST char *utfname; - 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 @@ -338,22 +318,20 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) * 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 +340,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) closedir(d); Tcl_DStringFree(&ds); Tcl_DStringFree(&dsOrig); - return result; + return TCL_OK; } } static int diff --git a/win/tclWinFile.c b/win/tclWinFile.c index b67a148..128e147 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.42 2003/02/07 15:29:34 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.43 2003/02/10 10:26:26 vincentdarley Exp $ */ //#define _WIN32_WINNT 0x0500 @@ -667,7 +667,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) * 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,40 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) 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 +722,8 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) 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 +731,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) } 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 +745,15 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) 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 +762,27 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) } /* + * 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 +799,40 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) } /* - * We need to check all files in the directory, so append a *.* - * to the path. - */ - - 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. + * Now iterate over all of the files in the directory, starting + * with the first one we found. */ - 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 +847,38 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) * 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 +978,7 @@ NativeMatchType( 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 { @@ -2047,7 +2026,7 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) int isDrive = 1; Tcl_DString ds; - currentPathEndPosition = path + nextCheckpoint; + currentPathEndPosition = path + nextCheckpoint + 1; while (1) { char cur = *currentPathEndPosition; if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) { @@ -2116,7 +2095,7 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) int isDrive = 1; Tcl_DString ds; - currentPathEndPosition = path + nextCheckpoint; + currentPathEndPosition = path + nextCheckpoint + 1; while (1) { char cur = *currentPathEndPosition; if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) { -- cgit v0.12