Attachment "fs-682500.diff" to
ticket [682500ffff]
added by
hobbs
2003-02-09 11:49:28.
? generic/hobbs
? generic/tclExecute.c.better
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.71
diff -u -r1.71 tclIOUtil.c
--- generic/tclIOUtil.c 4 Feb 2003 17:06:50 -0000 1.71
+++ generic/tclIOUtil.c 9 Feb 2003 04:40:44 -0000
@@ -37,12 +37,14 @@
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* 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 +63,7 @@
"path", /* name */
FreeFsPathInternalRep, /* freeIntRepProc */
DupFsPathInternalRep, /* dupIntRepProc */
- NULL, /* updateStringProc */
+ UpdateStringOfFsPath, /* updateStringProc */
SetFsPathFromAny /* setFromAnyProc */
};
@@ -495,7 +497,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 +510,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 +602,8 @@
*/
void
-TclFinalizeFilesystem() {
+TclFinalizeFilesystem()
+{
/*
* Assumption that only one thread is active now. Otherwise
* we would need to put various mutexes around this code.
@@ -996,9 +1002,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 +1017,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 +1049,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,16 +1091,15 @@
* 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
+ * 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.
@@ -1099,12 +1107,12 @@
*---------------------------------------------------------------------------
*/
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 +1126,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 +1140,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 +1154,7 @@
}
FsReleaseIterator();
- return (retVal);
+ return (startAt);
}
/*
@@ -1899,9 +1907,7 @@
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);
/*
* We know the cwd is a normalised object which does
@@ -1915,9 +1921,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,27 +1931,22 @@
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;
@@ -3766,20 +3765,34 @@
if (objPtr->typePtr == &tclFsPathType) {
FsPath *fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr;
if (fsPathPtr->filesystemEpoch != theFilesystemEpoch) {
+ if (objPtr->bytes == NULL) {
+ /*
+ * We need a valid string value before we invalidate.
+ */
+ Tcl_GetString(objPtr);
+ }
FreeFsPathInternalRep(objPtr);
objPtr->typePtr = NULL;
return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
}
- if (fsPathPtr->cwdPtr == NULL) {
+ /*
+ * FIX FIX: This is bogus, and may be the cause of Unix's inability
+ * to use TclNewFSPathObj -- hobbs
+ return TCL_OK;
+ */
+ if ((fsPathPtr->cwdPtr == NULL)
+ || FsCwdPointerEquals(fsPathPtr->cwdPtr)) {
return TCL_OK;
} else {
- if (FsCwdPointerEquals(fsPathPtr->cwdPtr)) {
- return TCL_OK;
- } else {
- FreeFsPathInternalRep(objPtr);
- objPtr->typePtr = NULL;
- return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
+ if (objPtr->bytes == NULL) {
+ /*
+ * We need a valid string value before we invalidate.
+ */
+ Tcl_GetString(objPtr);
}
+ FreeFsPathInternalRep(objPtr);
+ objPtr->typePtr = NULL;
+ return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
}
} else {
return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
@@ -3823,6 +3836,126 @@
/*
*---------------------------------------------------------------------------
*
+ * 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;
+ Tcl_Obj *copyObj;
+ CONST char *cwdStr;
+ int cwdLen;
+
+ if (fsPathPtr->flags == 0 || fsPathPtr->cwdPtr == NULL) {
+ panic("Called UpdateStringOfFsPath with invalid object");
+ }
+
+ copyObj = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
+ Tcl_IncrRefCount(copyObj);
+
+ cwdStr = Tcl_GetStringFromObj(copyObj, &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(copyObj, "/", 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 (cwdLen > 2 && cwdStr[cwdLen-1] != '/'
+ && cwdStr[cwdLen-1] != '\\') {
+ Tcl_AppendToObj(copyObj, "/", 1);
+ cwdLen++;
+ }
+ break;
+ case TCL_PLATFORM_MAC:
+ if (cwdStr[cwdLen-1] != ':') {
+ Tcl_AppendToObj(copyObj, ":", 1);
+ cwdLen++;
+ }
+ break;
+ }
+
+ Tcl_AppendObjToObj(copyObj, fsPathPtr->normPathPtr);
+ objPtr->bytes = Tcl_GetStringFromObj(copyObj, &cwdLen);
+ objPtr->length = cwdLen;
+ copyObj->bytes = tclEmptyStringRep;
+ copyObj->length = 0;
+ Tcl_DecrRefCount(copyObj);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * 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;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* SetFsPathFromAbsoluteNormalized --
*
* Like SetFsPathFromAny, but assumes the given object is an
@@ -3870,6 +4003,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;
@@ -3931,7 +4065,7 @@
* or MacOS (fCmd.test, fileName.test and cmdAH.test exercise
* most of the code).
*/
- name = Tcl_GetStringFromObj(objPtr,&len);
+ name = Tcl_GetStringFromObj(objPtr, &len);
/*
* Handle tilde substitutions, if needed.
@@ -4031,6 +4165,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 +4257,7 @@
fsPathPtr->translatedPathPtr = NULL;
/* Circular reference, by design */
fsPathPtr->normPathPtr = objPtr;
+ fsPathPtr->flags = 0;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = clientData;
fsPathPtr->fsRecPtr = fsFromPtr;
@@ -4153,14 +4289,11 @@
if (fsPathPtr->cwdPtr != NULL) {
Tcl_DecrRefCount(fsPathPtr->cwdPtr);
}
- if (fsPathPtr->nativePathPtr != NULL) {
- if (fsPathPtr->fsRecPtr != NULL) {
- if (fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc != NULL) {
- (*fsPathPtr->fsRecPtr->fsPtr
- ->freeInternalRepProc)(fsPathPtr->nativePathPtr);
- fsPathPtr->nativePathPtr = NULL;
- }
- }
+ if ((fsPathPtr->nativePathPtr != NULL) && (fsPathPtr->fsRecPtr != NULL)
+ && (fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc != NULL)) {
+ (*fsPathPtr->fsRecPtr->fsPtr
+ ->freeInternalRepProc)(fsPathPtr->nativePathPtr);
+ fsPathPtr->nativePathPtr = NULL;
}
if (fsPathPtr->fsRecPtr != NULL) {
fsPathPtr->fsRecPtr->fileRefCount--;
@@ -4209,6 +4342,8 @@
copyFsPathPtr->cwdPtr = NULL;
}
+ copyFsPathPtr->flags = srcFsPathPtr->flags;
+
if (srcFsPathPtr->fsRecPtr != NULL
&& srcFsPathPtr->nativePathPtr != NULL) {
dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
@@ -4295,8 +4430,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,28 +4465,119 @@
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) {
- int relative = 0;
+ 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!
+ */
+ TclNormalizeToUniquePath(interp, copy, dirLen);
+ /* 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)
+ && (!FsCwdPointerEquals(fsPathPtr->cwdPtr))) {
+ FreeFsPathInternalRep(pathObjPtr);
+ pathObjPtr->typePtr = NULL;
+ if (Tcl_ConvertToType(interp, pathObjPtr, &tclFsPathType) != TCL_OK) {
+ return NULL;
+ }
+ fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
+ }
+ if (fsPathPtr->normPathPtr == NULL) {
+ char *normStr, *pathStr;
+ int normLen, pathLen, 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;
- char *path = Tcl_GetString(absolutePath);
-
+ Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr;
+
+ pathStr = Tcl_GetStringFromObj(absolutePath, &pathLen);
+
/*
* We have to be a little bit careful here to avoid infinite loops
* we're asking Tcl_FSGetPathType to return the path's type, but
* that call can actually result in a lot of other filesystem
* action, which might loop back through here.
*/
- if ((path[0] != '\0') &&
- (Tcl_FSGetPathType(pathObjPtr) == TCL_PATH_RELATIVE)) {
+ if ((pathStr[0] != '\0') &&
+ (Tcl_FSGetPathType(pathObjPtr) == TCL_PATH_RELATIVE)) {
Tcl_Obj *cwd = Tcl_FSGetCwd(interp);
if (cwd == NULL) {
@@ -4365,19 +4591,20 @@
relative = 1;
}
/* Already has refCount incremented */
- srcFsPathPtr->normPathPtr = FSNormalizeAbsolutePath(interp, absolutePath);
- if (!strcmp(Tcl_GetString(srcFsPathPtr->normPathPtr),
- Tcl_GetString(pathObjPtr))) {
+ fsPathPtr->normPathPtr = FSNormalizeAbsolutePath(interp, absolutePath);
+ normStr = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &normLen);
+ pathStr = Tcl_GetStringFromObj(pathObjPtr, &pathLen);
+ if ((normLen == pathLen) && (strcmp(normStr, pathStr) == 0)) {
/*
* 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 +4612,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;
}
/*
@@ -5021,12 +5248,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 +5272,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
diff -u -r1.117 tclInt.h
--- generic/tclInt.h 4 Feb 2003 17:06:50 -0000 1.117
+++ generic/tclInt.h 9 Feb 2003 04:40:44 -0000
@@ -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: unix/tclUnixFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFCmd.c,v
retrieving revision 1.26
diff -u -r1.26 tclUnixFCmd.c
--- unix/tclUnixFCmd.c 4 Feb 2003 17:06:52 -0000 1.26
+++ unix/tclUnixFCmd.c 9 Feb 2003 04:40:44 -0000
@@ -1667,10 +1667,24 @@
char normPath[MAXPATHLEN];
Tcl_DString ds;
CONST char *nativePath;
+ char *lastDir;
#endif
currentPathEndPosition = path + nextCheckpoint;
+#ifndef NO_REALPATH
+ /* For speed, try to get the entire path in one go */
+ 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,6 +1727,7 @@
nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds);
if (Realpath(nativePath, normPath) != NULL) {
+ wholeStringOk:
/*
* Free up the native path and put in its place the
* converted, normalized path.
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 9 Feb 2003 04:40:44 -0000
@@ -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,41 +271,32 @@
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,30 @@
* 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) {
+#if 1
Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
+ TclNewFSPathObj(pathPtr, utfname,
+ Tcl_DStringLength(&utfDs)));
+#else
+ CONST char *fullname = Tcl_DStringAppend(&dsOrig, utfname,
+ Tcl_DStringLength(&utfDs));
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_NewStringObj(fullname,
+ Tcl_DStringLength(&dsOrig)));
+ /* Restore dsOrig to dirLength for next use. */
+ Tcl_DStringSetLength(&dsOrig, dirLength);
+#endif
}
}
Tcl_DStringFree(&utfDs);
@@ -362,7 +350,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
diff -u -r1.42 tclWinFile.c
--- win/tclWinFile.c 7 Feb 2003 15:29:34 -0000 1.42
+++ win/tclWinFile.c 9 Feb 2003 04:40:44 -0000
@@ -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,40 @@
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 @@
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 @@
} 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 @@
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 @@
}
/*
+ * 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 @@
}
/*
- * 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,55 +847,37 @@
* the system.
*/
- if (Tcl_StringCaseMatch(name, pattern, 1) == 0) {
- Tcl_DStringFree(&ds);
- continue;
+ if (Tcl_StringCaseMatch(utfname, pattern, 1)) {
+ /*
+ * If the file matches, then we need to process the remainder
+ * of the path.
+ */
+
+ 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)));
+ }
}
/*
- * If the file matches, then we need to process the remainder
- * of the path.
- */
-
- Tcl_DStringAppend(&dsOrig, name, -1);
- Tcl_DStringFree(&ds);
-
- 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)));
- }
- /*
- * 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;
}
}
