diff options
Diffstat (limited to 'generic/tclPathObj.c')
| -rw-r--r-- | generic/tclPathObj.c | 1090 |
1 files changed, 560 insertions, 530 deletions
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 9ed241a..fe6063f 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -9,8 +9,6 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclPathObj.c,v 1.49 2006/01/12 18:35:28 vasiljevic Exp $ */ #include "tclInt.h" @@ -20,20 +18,24 @@ * Prototypes for functions defined later in this file. */ -static void DupFsPathInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); -static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); -static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); -static int FindSplitPos(CONST char *path, int separator); -static int IsSeparatorOrNull(int ch); -static Tcl_Obj* GetExtension(Tcl_Obj *pathPtr); +static Tcl_Obj * AppendPath(Tcl_Obj *head, Tcl_Obj *tail); +static void DupFsPathInternalRep(Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr); +static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); +static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); +static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); +static int FindSplitPos(const char *path, int separator); +static int IsSeparatorOrNull(int ch); +static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); +static int MakePathFromNormalized(Tcl_Interp *interp, + Tcl_Obj *pathPtr); /* * Define the 'path' object type, which Tcl uses to represent file paths * internally. */ -static Tcl_ObjType tclFsPathType = { +static const Tcl_ObjType tclFsPathType = { "path", /* name */ FreeFsPathInternalRep, /* freeIntRepProc */ DupFsPathInternalRep, /* dupIntRepProc */ @@ -92,9 +94,7 @@ typedef struct FsPath { * generated during the correct filesystem * epoch. The epoch changes when * filesystem-mounts are changed. */ - struct FilesystemRecord *fsRecPtr; - /* Pointer to the filesystem record entry to - * use for this path. */ + const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */ } FsPath; /* @@ -102,15 +102,17 @@ typedef struct FsPath { */ #define TCLPATH_APPENDED 1 +#define TCLPATH_NEEDNORM 4 /* * Define some macros to give us convenient access to path-object specific * fields. */ -#define PATHOBJ(pathPtr) (pathPtr->internalRep.otherValuePtr) -#define PATHFLAGS(pathPtr) \ - (((FsPath*)(pathPtr->internalRep.otherValuePtr))->flags) +#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1) +#define SETPATHOBJ(pathPtr,fsPathPtr) \ + ((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr)) +#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags) /* *--------------------------------------------------------------------------- @@ -150,15 +152,9 @@ typedef struct FsPath { Tcl_Obj * TclFSNormalizeAbsolutePath( Tcl_Interp *interp, /* Interpreter to use */ - Tcl_Obj *pathPtr, /* Absolute path to normalize */ - ClientData *clientDataPtr) /* If non-NULL, then may be set to the - * fs-specific clientData for this path. This - * will happen when that extra information can - * be calculated efficiently as a side-effect - * of normalization. */ + Tcl_Obj *pathPtr) /* Absolute path to normalize */ { - ClientData clientData = NULL; - CONST char *dirSep, *oldDirSep; + const char *dirSep, *oldDirSep; int first = 1; /* Set to zero once we've passed the first * directory separator - we can't use '..' to * remove the volume in a path. */ @@ -166,6 +162,21 @@ TclFSNormalizeAbsolutePath( dirSep = TclGetString(pathPtr); if (tclPlatform == TCL_PLATFORM_WINDOWS) { + if ( (dirSep[0] == '/' || dirSep[0] == '\\') + && (dirSep[1] == '/' || dirSep[1] == '\\') + && (dirSep[2] == '?') + && (dirSep[3] == '/' || dirSep[3] == '\\')) { + /* NT extended path */ + dirSep += 4; + + if ( (dirSep[0] == 'U' || dirSep[0] == 'u') + && (dirSep[1] == 'N' || dirSep[1] == 'n') + && (dirSep[2] == 'C' || dirSep[2] == 'c') + && (dirSep[3] == '/' || dirSep[3] == '\\')) { + /* NT extended UNC path */ + dirSep += 4; + } + } if (dirSep[0] != 0 && dirSep[1] == ':' && (dirSep[2] == '/' || dirSep[2] == '\\')) { /* Do nothing */ @@ -213,12 +224,17 @@ TclFSNormalizeAbsolutePath( /* * Need to skip '.' in the path. */ + int curLen; if (retVal == NULL) { - CONST char *path = TclGetString(pathPtr); + const char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } + Tcl_GetStringFromObj(retVal, &curLen); + if (curLen == 0) { + Tcl_AppendToObj(retVal, dirSep, 1); + } dirSep += 2; oldDirSep = dirSep; if (dirSep[0] != 0 && dirSep[1] == '.') { @@ -227,7 +243,7 @@ TclFSNormalizeAbsolutePath( continue; } if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) { - Tcl_Obj *link; + Tcl_Obj *linkObj; int curLen; char *linkStr; @@ -236,28 +252,42 @@ TclFSNormalizeAbsolutePath( */ if (retVal == NULL) { - CONST char *path = TclGetString(pathPtr); + const char *path = TclGetString(pathPtr); + retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } + Tcl_GetStringFromObj(retVal, &curLen); + if (curLen == 0) { + Tcl_AppendToObj(retVal, dirSep, 1); + } if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) { - link = Tcl_FSLink(retVal, NULL, 0); - if (link != NULL) { + linkObj = Tcl_FSLink(retVal, NULL, 0); + + /* Safety check in case driver caused sharing */ + if (Tcl_IsShared(retVal)) { + TclDecrRefCount(retVal); + retVal = Tcl_DuplicateObj(retVal); + Tcl_IncrRefCount(retVal); + } + + if (linkObj != NULL) { /* * Got a link. Need to check if the link is relative * or absolute, for those platforms where relative * links exist. */ - if (tclPlatform != TCL_PLATFORM_WINDOWS && - Tcl_FSGetPathType(link) == TCL_PATH_RELATIVE) { + if (tclPlatform != TCL_PLATFORM_WINDOWS + && Tcl_FSGetPathType(linkObj) + == TCL_PATH_RELATIVE) { /* * We need to follow this link which is relative * to retVal's directory. This means concatenating * the link onto the directory of the path so far. */ - CONST char *path = + const char *path = Tcl_GetStringFromObj(retVal, &curLen); while (--curLen >= 0) { @@ -265,19 +295,14 @@ TclFSNormalizeAbsolutePath( break; } } - if (Tcl_IsShared(retVal)) { - TclDecrRefCount(retVal); - retVal = Tcl_DuplicateObj(retVal); - Tcl_IncrRefCount(retVal); - } /* * We want the trailing slash. */ Tcl_SetObjLength(retVal, curLen+1); - Tcl_AppendObjToObj(retVal, link); - TclDecrRefCount(link); + Tcl_AppendObjToObj(retVal, linkObj); + TclDecrRefCount(linkObj); linkStr = Tcl_GetStringFromObj(retVal, &curLen); } else { /* @@ -285,7 +310,12 @@ TclFSNormalizeAbsolutePath( */ TclDecrRefCount(retVal); - retVal = link; + if (Tcl_IsShared(linkObj)) { + retVal = Tcl_DuplicateObj(linkObj); + TclDecrRefCount(linkObj); + } else { + retVal = linkObj; + } linkStr = Tcl_GetStringFromObj(retVal, &curLen); /* @@ -294,6 +324,7 @@ TclFSNormalizeAbsolutePath( if (tclPlatform == TCL_PLATFORM_WINDOWS) { int i; + for (i = 0; i < curLen; i++) { if (linkStr[i] == '\\') { linkStr[i] = '/'; @@ -306,18 +337,28 @@ TclFSNormalizeAbsolutePath( } /* - * Either way, we now remove the last path element. + * Either way, we now remove the last path element (but + * not the first character of the path). */ while (--curLen >= 0) { if (IsSeparatorOrNull(linkStr[curLen])) { - Tcl_SetObjLength(retVal, curLen); + if (curLen) { + Tcl_SetObjLength(retVal, curLen); + } else { + Tcl_SetObjLength(retVal, 1); + } break; } } } dirSep += 3; oldDirSep = dirSep; + + if ((curLen == 0) && (dirSep[0] != 0)) { + Tcl_SetObjLength(retVal, 0); + } + if (dirSep[0] != 0 && dirSep[1] == '.') { goto again; } @@ -358,12 +399,12 @@ TclFSNormalizeAbsolutePath( } /* - * Ensure a windows drive like C:/ has a trailing separator + * Ensure a windows drive like C:/ has a trailing separator. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { int len; - CONST char *path = Tcl_GetStringFromObj(retVal, &len); + const char *path = Tcl_GetStringFromObj(retVal, &len); if (len == 2 && path[0] != 0 && path[1] == ':') { if (Tcl_IsShared(retVal)) { @@ -386,17 +427,14 @@ TclFSNormalizeAbsolutePath( * for normalizing a path. */ - TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData); + TclFSNormalizeToUniquePath(interp, retVal, 0); /* * Since we know it is a normalized path, we can actually convert this * object into an FsPath for greater efficiency */ - TclFSMakePathFromNormalized(interp, retVal, clientData); - if (clientDataPtr != NULL) { - *clientDataPtr = clientData; - } + MakePathFromNormalized(interp, retVal); /* * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs. @@ -456,26 +494,36 @@ Tcl_FSGetPathType( Tcl_PathType TclFSGetPathType( Tcl_Obj *pathPtr, - Tcl_Filesystem **filesystemPtrPtr, + const Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr) { + FsPath *fsPathPtr; + if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { - return TclGetPathType(pathPtr, filesystemPtrPtr, - driveNameLengthPtr, NULL); - } else { - FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, + NULL); + } - if (fsPathPtr->cwdPtr != NULL) { - if (PATHFLAGS(pathPtr) == 0) { - return TCL_PATH_RELATIVE; - } - return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, - driveNameLengthPtr); - } else { - return TclGetPathType(pathPtr, filesystemPtrPtr, - driveNameLengthPtr, NULL); - } + fsPathPtr = PATHOBJ(pathPtr); + if (fsPathPtr->cwdPtr == NULL) { + return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, + NULL); + } + + if (PATHFLAGS(pathPtr) == 0) { + /* The path is not absolute... */ +#ifdef _WIN32 + /* ... on Windows we must make another call to determine whether + * it's relative or volumerelative [Bug 2571597]. */ + return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, + NULL); +#else + /* On other systems, quickly deduce !absolute -> relative */ + return TCL_PATH_RELATIVE; +#endif } + return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, + driveNameLengthPtr); } /* @@ -516,9 +564,9 @@ TclPathPart( Tcl_PathPart portion) /* Requested portion of name */ { if (pathPtr->typePtr == &tclFsPathType) { - FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); - if (TclFSEpochOk(fsPathPtr->filesystemEpoch) - && (PATHFLAGS(pathPtr) != 0)) { + FsPath *fsPathPtr = PATHOBJ(pathPtr); + + if (PATHFLAGS(pathPtr) != 0) { switch (portion) { case TCL_PATH_DIRNAME: { /* @@ -529,11 +577,24 @@ TclPathPart( * the standardPath code. */ - CONST char *rest = TclGetString(fsPathPtr->normPathPtr); + int numBytes; + const char *rest = + Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; } + /* + * If the joined-on bit is empty, then [file dirname] is + * documented to return all but the last non-empty element + * of the path, so we need to split apart the main part to + * get the right answer. We could do that here, but it's + * simpler to fall back to the standardPath code. + * [Bug 2710920] + */ + if (numBytes == 0) { + goto standardPath; + } if (tclPlatform == TCL_PLATFORM_WINDOWS && strchr(rest, '\\') != NULL) { goto standardPath; @@ -554,11 +615,24 @@ TclPathPart( * we don't, and instead just use the standardPath code. */ - CONST char *rest = TclGetString(fsPathPtr->normPathPtr); + int numBytes; + const char *rest = + Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; } + /* + * If the joined-on bit is empty, then [file tail] is + * documented to return the last non-empty element + * of the path, so we need to split off the last element + * of the main part to get the right answer. We could do + * that here, but it's simpler to fall back to the + * standardPath code. [Bug 2710920] + */ + if (numBytes == 0) { + goto standardPath; + } if (tclPlatform == TCL_PLATFORM_WINDOWS && strchr(rest, '\\') != NULL) { goto standardPath; @@ -569,7 +643,7 @@ TclPathPart( case TCL_PATH_EXTENSION: return GetExtension(fsPathPtr->normPathPtr); case TCL_PATH_ROOT: { - CONST char *fileName, *extension; + const char *fileName, *extension; int length; fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, @@ -585,34 +659,18 @@ TclPathPart( return pathPtr; } else { /* - * Duplicate the object we were given and then trim off - * the extension of the tail component of the path. + * Need to return the whole path with the extension + * suffix removed. Do that by joining our "head" to + * our "tail" with the extension suffix removed from + * the tail. */ - FsPath *fsDupPtr; - Tcl_Obj *root = Tcl_DuplicateObj(pathPtr); - - Tcl_IncrRefCount(root); - fsDupPtr = (FsPath*) PATHOBJ(root); - if (Tcl_IsShared(fsDupPtr->normPathPtr)) { - TclDecrRefCount(fsDupPtr->normPathPtr); - fsDupPtr->normPathPtr = Tcl_NewStringObj(fileName, - (int)(length - strlen(extension))); - Tcl_IncrRefCount(fsDupPtr->normPathPtr); - } else { - Tcl_SetObjLength(fsDupPtr->normPathPtr, - (int)(length - strlen(extension))); - } - - /* - * Must also trim the string representation if we have it. - */ + Tcl_Obj *resultPtr = + TclNewFSPathObj(fsPathPtr->cwdPtr, fileName, + (int)(length - strlen(extension))); - if (root->bytes != NULL && root->length > 0) { - root->length -= strlen(extension); - root->bytes[root->length] = 0; - } - return root; + Tcl_IncrRefCount(resultPtr); + return resultPtr; } } default: @@ -630,8 +688,7 @@ TclPathPart( } } else { int splitElements; - Tcl_Obj *splitPtr; - Tcl_Obj *resultPtr; + Tcl_Obj *splitPtr, *resultPtr; standardPath: resultPtr = NULL; @@ -639,7 +696,7 @@ TclPathPart( return GetExtension(pathPtr); } else if (portion == TCL_PATH_ROOT) { int length; - CONST char *fileName, *extension; + const char *fileName, *extension; fileName = Tcl_GetStringFromObj(pathPtr, &length); extension = TclGetExtension(fileName); @@ -649,6 +706,7 @@ TclPathPart( } else { Tcl_Obj *root = Tcl_NewStringObj(fileName, (int) (length - strlen(extension))); + Tcl_IncrRefCount(root); return root; } @@ -697,7 +755,7 @@ TclPathPart( resultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1); } else if (splitElements == 0 || (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) { - resultPtr = Tcl_NewStringObj(".", 1); + TclNewLiteralStringObj(resultPtr, "."); } else { Tcl_ListObjIndex(NULL, splitPtr, 0, &resultPtr); } @@ -716,7 +774,7 @@ static Tcl_Obj * GetExtension( Tcl_Obj *pathPtr) { - CONST char *tail, *extension; + const char *tail, *extension; Tcl_Obj *ret; tail = TclGetString(pathPtr); @@ -770,48 +828,39 @@ Tcl_FSJoinPath( * reference count. */ int elements) /* Number of elements to use (-1 = all) */ { - Tcl_Obj *res; - int i; - Tcl_Filesystem *fsPtr = NULL; + Tcl_Obj *copy, *res; + int objc; + Tcl_Obj **objv; - if (elements < 0) { - if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) { - return NULL; - } - } else { - /* - * Just make sure it is a valid list. - */ - - int listTest; - - if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) { - return NULL; - } + if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) { + return NULL; + } - /* - * Correct this if it is too large, otherwise we will waste our time - * joining null elements to the path. - */ + elements = ((elements >= 0) && (elements <= objc)) ? elements : objc; + copy = TclListObjCopy(NULL, listObj); + Tcl_ListObjGetElements(NULL, listObj, &objc, &objv); + res = TclJoinPath(elements, objv); + Tcl_DecrRefCount(copy); + return res; +} - if (elements > listTest) { - elements = listTest; - } - } +Tcl_Obj * +TclJoinPath( + int elements, + Tcl_Obj * const objv[]) +{ + Tcl_Obj *res; + int i; + const Tcl_Filesystem *fsPtr = NULL; res = NULL; for (i = 0; i < elements; i++) { - Tcl_Obj *elt; - int driveNameLength; + int driveNameLength, strEltLen, length; Tcl_PathType type; - char *strElt; - int strEltLen; - int length; - char *ptr; + char *strElt, *ptr; Tcl_Obj *driveName = NULL; - - Tcl_ListObjIndex(NULL, listObj, i, &elt); + Tcl_Obj *elt = objv[i]; /* * This is a special case where we can be much more efficient, where @@ -822,18 +871,17 @@ Tcl_FSJoinPath( * could expand that in the future. */ - if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType) - && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) { - Tcl_Obj *tail; - Tcl_PathType type; + if ((i == (elements-2)) && (i == 0) + && (elt->typePtr == &tclFsPathType) + && !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))) { + Tcl_Obj *tailObj = objv[i+1]; - Tcl_ListObjIndex(NULL, listObj, i+1, &tail); - type = TclGetPathType(tail, NULL, NULL, NULL); + type = TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { - CONST char *str; + const char *str; int len; - str = Tcl_GetStringFromObj(tail, &len); + str = Tcl_GetStringFromObj(tailObj, &len); if (len == 0) { /* * This happens if we try to handle the root volume '/'. @@ -875,24 +923,22 @@ Tcl_FSJoinPath( /* * Otherwise we don't have an easy join, and we must let the - * more general code below handle things + * more general code below handle things. */ } else if (tclPlatform == TCL_PLATFORM_UNIX) { if (res != NULL) { TclDecrRefCount(res); } - return tail; + return tailObj; } else { - CONST char *str; - int len; + const char *str = TclGetString(tailObj); - str = Tcl_GetStringFromObj(tail, &len); if (tclPlatform == TCL_PLATFORM_WINDOWS) { if (strchr(str, '\\') == NULL) { if (res != NULL) { TclDecrRefCount(res); } - return tail; + return tailObj; } } } @@ -928,6 +974,8 @@ Tcl_FSJoinPath( res = Tcl_NewStringObj(strElt, driveNameLength); } strElt += driveNameLength; + } else if (driveName != NULL) { + Tcl_DecrRefCount(driveName); } /* @@ -967,8 +1015,8 @@ Tcl_FSJoinPath( } /* - * This element is just what we want to return already - no - * further manipulation is requred. + * This element is just what we want to return already; no further + * manipulation is requred. */ return elt; @@ -980,7 +1028,6 @@ Tcl_FSJoinPath( */ noQuickReturn: - if (res == NULL) { res = Tcl_NewObj(); ptr = Tcl_GetStringFromObj(res, &length); @@ -1015,15 +1062,22 @@ Tcl_FSJoinPath( int needsSep = 0; if (fsPtr->filesystemSeparatorProc != NULL) { - Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res); + Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(res); + if (sep != NULL) { separator = TclGetString(sep)[0]; } + /* Safety check in case the VFS driver caused sharing */ + if (Tcl_IsShared(res)) { + TclDecrRefCount(res); + res = Tcl_DuplicateObj(res); + Tcl_IncrRefCount(res); + } } if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); - length++; + Tcl_GetStringFromObj(res, &length); } Tcl_SetObjLength(res, length + (int) strlen(strElt)); @@ -1092,40 +1146,38 @@ Tcl_FSConvertToPathType( */ if (pathPtr->typePtr == &tclFsPathType) { - FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); - if (!TclFSEpochOk(fsPathPtr->filesystemEpoch)) { - if (pathPtr->bytes == NULL) { - UpdateStringOfFsPath(pathPtr); - } - FreeFsPathInternalRep(pathPtr); - pathPtr->typePtr = NULL; - return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) { + return TCL_OK; } - return TCL_OK; - /* - * We used to have more complex code here: - * - * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) { - * return TCL_OK; - * } else { - * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { - * return TCL_OK; - * } else { - * if (pathPtr->bytes == NULL) { - * UpdateStringOfFsPath(pathPtr); - * } - * FreeFsPathInternalRep(pathPtr); - * pathPtr->typePtr = NULL; - * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); - * } - * } - * - * But we no longer believe this is necessary. - */ - } else { - return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + if (pathPtr->bytes == NULL) { + UpdateStringOfFsPath(pathPtr); + } + FreeFsPathInternalRep(pathPtr); } + + return SetFsPathFromAny(interp, pathPtr); + + /* + * We used to have more complex code here: + * + * FsPath *fsPathPtr = PATHOBJ(pathPtr); + * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) { + * return TCL_OK; + * } else { + * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { + * return TCL_OK; + * } else { + * if (pathPtr->bytes == NULL) { + * UpdateStringOfFsPath(pathPtr); + * } + * FreeFsPathInternalRep(pathPtr); + * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + * } + * } + * + * But we no longer believe this is necessary. + */ } /* @@ -1156,7 +1208,7 @@ IsSeparatorOrNull( static int FindSplitPos( - CONST char *path, + const char *path, int separator) { int count = 0; @@ -1207,17 +1259,40 @@ FindSplitPos( Tcl_Obj * TclNewFSPathObj( Tcl_Obj *dirPtr, - CONST char *addStrRep, + const char *addStrRep, int len) { FsPath *fsPathPtr; Tcl_Obj *pathPtr; - ThreadSpecificData *tsdPtr; + const char *p; + int state = 0, count = 0; + + /* [Bug 2806250] - this is only a partial solution of the problem. + * The PATHFLAGS != 0 representation assumes in many places that + * the "tail" part stored in the normPathPtr field is itself a + * relative path. Strings that begin with "~" are not relative paths, + * so we must prevent their storage in the normPathPtr field. + * + * More generally we ought to be testing "addStrRep" for any value + * that is not a relative path, but in an unconstrained VFS world + * that could be just about anything, and testing could be expensive. + * Since this routine plays a big role in [glob], anything that slows + * it down would be unwelcome. For now, continue the risk of further + * bugs when some Tcl_Filesystem uses otherwise relative path strings + * as absolute path strings. Sensible Tcl_Filesystems will avoid + * that by mounting on path prefixes like foo:// which cannot be the + * name of a file or directory read from a native [glob] operation. + */ + if (addStrRep[0] == '~') { + Tcl_Obj *tail = Tcl_NewStringObj(addStrRep, len); - tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + pathPtr = AppendPath(dirPtr, tail); + Tcl_DecrRefCount(tail); + return pathPtr; + } pathPtr = Tcl_NewObj(); - fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); + fsPathPtr = ckalloc(sizeof(FsPath)); /* * Set up the path. @@ -1229,17 +1304,82 @@ TclNewFSPathObj( fsPathPtr->cwdPtr = dirPtr; Tcl_IncrRefCount(dirPtr); fsPathPtr->nativePathPtr = NULL; - fsPathPtr->fsRecPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->fsPtr = NULL; + fsPathPtr->filesystemEpoch = 0; - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = TCLPATH_APPENDED; pathPtr->typePtr = &tclFsPathType; pathPtr->bytes = NULL; pathPtr->length = 0; + /* + * Look for path components made up of only "." + * This is overly conservative analysis to keep simple. It may mark some + * things as needing more aggressive normalization that don't actually + * need it. No harm done. + */ + for (p = addStrRep; len > 0; p++, len--) { + switch (state) { + case 0: /* So far only "." since last dirsep or start */ + switch (*p) { + case '.': + count++; + break; + case '/': + case '\\': + case ':': + if (count) { + PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM; + len = 0; + } + break; + default: + count = 0; + state = 1; + } + case 1: /* Scanning for next dirsep */ + switch (*p) { + case '/': + case '\\': + case ':': + state = 0; + break; + } + } + } + if (len == 0 && count) { + PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM; + } + return pathPtr; } + +static Tcl_Obj * +AppendPath( + Tcl_Obj *head, + Tcl_Obj *tail) +{ + int numBytes; + const char *bytes; + Tcl_Obj *copy = Tcl_DuplicateObj(head); + + /* + * This is likely buggy when dealing with virtual filesystem drivers + * that use some character other than "/" as a path separator. I know + * of no evidence that such a foolish thing exists. This solution was + * chosen so that "JoinPath" operations that pass through either path + * intrep produce the same results; that is, bugward compatibility. If + * we need to fix that bug here, it needs fixing in TclJoinPath() too. + */ + bytes = Tcl_GetStringFromObj(tail, &numBytes); + if (numBytes == 0) { + Tcl_AppendToObj(copy, "/", 1); + } else { + TclpNativeJoinPath(copy, bytes); + } + return copy; +} /* *--------------------------------------------------------------------------- @@ -1253,11 +1393,6 @@ TclNewFSPathObj( * directory. Returns a Tcl_Obj representing filename of the path * relative to the directory. * - * In the case where the resulting path would start with a '~', we take - * special care to return an ordinary string. This means to use that path - * (and not have it interpreted as a user name), one must prepend './'. - * This may seem strange, but that is how 'glob' is currently defined. - * * Results: * NULL on error, otherwise a valid object, typically with refCount of * zero, which it is assumed the caller will increment. @@ -1275,67 +1410,13 @@ TclFSMakePathRelative( Tcl_Obj *cwdPtr) /* Make it relative to this. */ { int cwdLen, len; - CONST char *tempStr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + const char *tempStr; if (pathPtr->typePtr == &tclFsPathType) { - FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); - if (PATHFLAGS(pathPtr) != 0 - && fsPathPtr->cwdPtr == cwdPtr) { - pathPtr = fsPathPtr->normPathPtr; - - /* - * Free old representation. - */ - - if (pathPtr->typePtr != NULL) { - if (pathPtr->bytes == NULL) { - if (pathPtr->typePtr->updateStringProc == NULL) { - if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't find object", - "string representation", (char *) NULL); - } - return NULL; - } - pathPtr->typePtr->updateStringProc(pathPtr); - } - TclFreeIntRep(pathPtr); - } - - /* - * Now pathPtr is a string object. - */ - - if (Tcl_GetString(pathPtr)[0] == '~') { - /* - * If the first character of the path is a tilde, we must just - * return the path as is, to agree with the defined behaviour - * of 'glob'. - */ - - return pathPtr; - } - - fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); - - /* - * Circular reference, by design. - */ - - fsPathPtr->translatedPathPtr = pathPtr; - fsPathPtr->normPathPtr = NULL; - fsPathPtr->cwdPtr = cwdPtr; - Tcl_IncrRefCount(cwdPtr); - fsPathPtr->nativePathPtr = NULL; - fsPathPtr->fsRecPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + FsPath *fsPathPtr = PATHOBJ(pathPtr); - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; - PATHFLAGS(pathPtr) = 0; - pathPtr->typePtr = &tclFsPathType; - - return pathPtr; + if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { + return fsPathPtr->normPathPtr; } } @@ -1378,7 +1459,7 @@ TclFSMakePathRelative( /* *--------------------------------------------------------------------------- * - * TclFSMakePathFromNormalized -- + * MakePathFromNormalized -- * * Like SetFsPathFromAny, but assumes the given object is an absolute * normalized path. Only for internal use. @@ -1392,15 +1473,12 @@ TclFSMakePathRelative( *--------------------------------------------------------------------------- */ -int -TclFSMakePathFromNormalized( +static int +MakePathFromNormalized( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *pathPtr, /* The object to convert. */ - ClientData nativeRep) /* The native rep for the object, if known - * else NULL. */ + Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; @@ -1414,9 +1492,10 @@ TclFSMakePathFromNormalized( if (pathPtr->bytes == NULL) { if (pathPtr->typePtr->updateStringProc == NULL) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't find object", - "string representation", (char *) NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't find object string representation", -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF", + NULL); } return TCL_ERROR; } @@ -1425,7 +1504,7 @@ TclFSMakePathFromNormalized( TclFreeIntRep(pathPtr); } - fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); + fsPathPtr = ckalloc(sizeof(FsPath)); /* * It's a pure normalized absolute path. @@ -1439,11 +1518,12 @@ TclFSMakePathFromNormalized( fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; - fsPathPtr->nativePathPtr = nativeRep; - fsPathPtr->fsRecPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->nativePathPtr = NULL; + fsPathPtr->fsPtr = NULL; + /* Remember the epoch under which we decided pathPtr was normalized */ + fsPathPtr->filesystemEpoch = TclFSEpoch(); - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; @@ -1477,17 +1557,16 @@ TclFSMakePathFromNormalized( Tcl_Obj * Tcl_FSNewNativePath( - Tcl_Filesystem *fromFilesystem, + const Tcl_Filesystem *fromFilesystem, ClientData clientData) { - Tcl_Obj *pathPtr; + Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; - FilesystemRecord *fsFromPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - pathPtr = TclFSInternalToNormalized(fromFilesystem, clientData, - &fsFromPtr); + if (fromFilesystem->internalToNormalizedProc != NULL) { + pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); + } if (pathPtr == NULL) { return NULL; } @@ -1507,7 +1586,7 @@ Tcl_FSNewNativePath( TclFreeIntRep(pathPtr); } - fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); + fsPathPtr = ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; @@ -1518,11 +1597,10 @@ Tcl_FSNewNativePath( fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; - fsPathPtr->fsRecPtr = fsFromPtr; - fsPathPtr->fsRecPtr->fileRefCount++; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->fsPtr = fromFilesystem; + fsPathPtr->filesystemEpoch = TclFSEpoch(); - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; @@ -1559,10 +1637,33 @@ Tcl_FSGetTranslatedPath( if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); if (srcFsPathPtr->translatedPathPtr == NULL) { if (PATHFLAGS(pathPtr) != 0) { - retObj = Tcl_FSGetNormalizedPath(interp, pathPtr); + /* + * We lack a translated path result, but we have a directory + * (cwdPtr) and a tail (normPathPtr), and if we join the + * translated version of cwdPtr to normPathPtr, we'll get the + * translated result we need, and can store it for future use. + */ + + Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp, + srcFsPathPtr->cwdPtr); + if (translatedCwdPtr == NULL) { + return NULL; + } + + retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1, + &srcFsPathPtr->normPathPtr); + srcFsPathPtr->translatedPathPtr = retObj; + if (translatedCwdPtr->typePtr == &tclFsPathType) { + srcFsPathPtr->filesystemEpoch + = PATHOBJ(translatedCwdPtr)->filesystemEpoch; + } else { + srcFsPathPtr->filesystemEpoch = 0; + } + Tcl_IncrRefCount(retObj); + Tcl_DecrRefCount(translatedCwdPtr); } else { /* * It is a pure absolute, normalized path object. This is @@ -1580,7 +1681,9 @@ Tcl_FSGetTranslatedPath( retObj = srcFsPathPtr->translatedPathPtr; } - Tcl_IncrRefCount(retObj); + if (retObj != NULL) { + Tcl_IncrRefCount(retObj); + } return retObj; } @@ -1603,7 +1706,7 @@ Tcl_FSGetTranslatedPath( *--------------------------------------------------------------------------- */ -CONST char * +const char * Tcl_FSGetTranslatedStringPath( Tcl_Interp *interp, Tcl_Obj *pathPtr) @@ -1612,11 +1715,10 @@ Tcl_FSGetTranslatedStringPath( if (transPtr != NULL) { int len; - CONST char *result, *orig; + const char *orig = Tcl_GetStringFromObj(transPtr, &len); + char *result = ckalloc(len+1); - orig = Tcl_GetStringFromObj(transPtr, &len); - result = (char*) ckalloc((unsigned)(len+1)); - memcpy((VOID*) result, (VOID*) orig, (size_t) (len+1)); + memcpy(result, orig, (size_t) len+1); TclDecrRefCount(transPtr); return result; } @@ -1653,7 +1755,7 @@ Tcl_FSGetNormalizedPath( if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } - fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0) { /* @@ -1662,70 +1764,77 @@ Tcl_FSGetNormalizedPath( */ Tcl_Obj *dir, *copy; - int cwdLen; - int pathType; - CONST char *cwdStr; - ClientData clientData = NULL; + int tailLen, cwdLen, pathType; pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); if (dir == NULL) { return NULL; } + /* TODO: Figure out why this is needed. */ if (pathPtr->bytes == NULL) { UpdateStringOfFsPath(pathPtr); } - copy = Tcl_DuplicateObj(dir); - Tcl_IncrRefCount(copy); + + Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen); + if (tailLen) { + copy = AppendPath(dir, fsPathPtr->normPathPtr); + } else { + copy = Tcl_DuplicateObj(dir); + } Tcl_IncrRefCount(dir); + Tcl_IncrRefCount(copy); /* * We now own a reference on both 'dir' and 'copy' */ - cwdStr = Tcl_GetStringFromObj(copy, &cwdLen); + (void) Tcl_GetStringFromObj(dir, &cwdLen); + cwdLen += (Tcl_GetString(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. We should never get cwdLen == 0 in this code path. - */ + /* Normalize the combined string. */ - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - if (cwdStr[cwdLen-1] != '/') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; - case TCL_PLATFORM_WINDOWS: - if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; - } - Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr); + if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) { + /* + * If the "tail" part has components (like /../) that cause the + * combined path to need more complete normalizing, call on the + * more powerful routine to accomplish that so we avoid [Bug + * 2385549] ... + */ - /* - * Normalize the combined string, but only starting after the end of - * the previously normalized 'dir'. This should be much faster! We use - * 'cwdLen-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. - */ + Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy); - TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); + Tcl_DecrRefCount(copy); + copy = newCopy; + } else { + /* + * ... but in most cases where we join a trouble free tail to a + * normalized head, we can more efficiently normalize the combined + * path by passing over only the unnormalized tail portion. When + * this is sufficient, prior developers claim this should be much + * faster. We use 'cwdLen-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. + */ - /* - * Now we need to construct the new path object - */ + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1); + } + + /* Now we need to construct the new path object. */ if (pathType == TCL_PATH_RELATIVE) { - FsPath* origDirFsPathPtr; Tcl_Obj *origDir = fsPathPtr->cwdPtr; - origDirFsPathPtr = (FsPath*) PATHOBJ(origDir); + + /* + * NOTE: here we are (dangerously?) assuming that origDir points + * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType. The + * pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); + * above that set the pathType value should have established that, + * but it's far less clear on what basis we know there's been no + * shimmering since then. + */ + + FsPath *origDirFsPathPtr = PATHOBJ(origDir); fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr; Tcl_IncrRefCount(fsPathPtr->cwdPtr); @@ -1751,9 +1860,6 @@ Tcl_FSGetNormalizedPath( TclDecrRefCount(dir); } - if (clientData != NULL) { - fsPathPtr->nativePathPtr = clientData; - } PATHFLAGS(pathPtr) = 0; } @@ -1767,60 +1873,32 @@ Tcl_FSGetNormalizedPath( UpdateStringOfFsPath(pathPtr); } FreeFsPathInternalRep(pathPtr); - pathPtr->typePtr = NULL; - if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) { + if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) { return NULL; } - fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + fsPathPtr = PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { int cwdLen; Tcl_Obj *copy; - CONST char *cwdStr; - ClientData clientData = NULL; - copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr); - Tcl_IncrRefCount(copy); - cwdStr = Tcl_GetStringFromObj(copy, &cwdLen); + copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); - /* - * 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. We should never get cwdLen == 0 in this - * code path. - */ - - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - if (cwdStr[cwdLen-1] != '/') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; - case TCL_PLATFORM_WINDOWS: - if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; - } - Tcl_AppendObjToObj(copy, pathPtr); + (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); + cwdLen += (Tcl_GetString(copy)[cwdLen] == '/'); /* * Normalize the combined string, but only starting after the end * of the previously normalized 'dir'. This should be much faster! */ - TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1); fsPathPtr->normPathPtr = copy; - if (clientData != NULL) { - fsPathPtr->nativePathPtr = clientData; - } + Tcl_IncrRefCount(fsPathPtr->normPathPtr); } } if (fsPathPtr->normPathPtr == NULL) { - ClientData clientData = NULL; Tcl_Obj *useThisCwd = NULL; + int pureNormalized = 1; /* * Since normPathPtr is NULL, but this is a valid path object, we know @@ -1828,7 +1906,9 @@ Tcl_FSGetNormalizedPath( */ Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr; - CONST char *path = TclGetString(absolutePath); + const char *path = TclGetString(absolutePath); + + Tcl_IncrRefCount(absolutePath); /* * We have to be a little bit careful here to avoid infinite loops @@ -1837,7 +1917,20 @@ Tcl_FSGetNormalizedPath( * might loop back through here. */ - if (path[0] != '\0') { + if (path[0] == '\0') { + /* + * Special handling for the empty string value. This one is very + * weird with [file normalize {}] => {}. (The reasoning supporting + * this is unknown to DGP, but he fears changing it.) Attempt here + * to keep the expectations of other parts of Tcl_Filesystem code + * about state of the FsPath fields satisfied. + * + * In particular, capture the cwd value and save so it can be + * stored in the cwdPtr field below. + */ + + useThisCwd = Tcl_FSGetCwd(interp); + } else { /* * We don't ask for the type of 'pathPtr' here, because that is * not correct for our purposes when we have a path like '~'. Tcl @@ -1855,24 +1948,28 @@ Tcl_FSGetNormalizedPath( return NULL; } + pureNormalized = 0; + Tcl_DecrRefCount(absolutePath); absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); Tcl_IncrRefCount(absolutePath); /* * We have a refCount on the cwd. */ -#ifdef __WIN32__ +#ifdef _WIN32 } else if (type == TCL_PATH_VOLUME_RELATIVE) { /* * Only Windows has volume-relative paths. */ + Tcl_DecrRefCount(absolutePath); absolutePath = TclWinVolumeRelativeNormalize(interp, path, &useThisCwd); if (absolutePath == NULL) { return NULL; } -#endif /* __WIN32__ */ + pureNormalized = 0; +#endif /* _WIN32 */ } } @@ -1881,21 +1978,20 @@ Tcl_FSGetNormalizedPath( */ fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, - absolutePath, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); - if (0 && (clientData != NULL)) { - fsPathPtr->nativePathPtr = - (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData); - } + absolutePath); /* * Check if path is pure normalized (this can only be the case if it * is an absolute path). */ - if (useThisCwd == NULL) { - if (!strcmp(TclGetString(fsPathPtr->normPathPtr), - TclGetString(pathPtr))) { + if (pureNormalized) { + int normPathLen, pathLen; + const char *normPath; + + path = TclGetStringFromObj(pathPtr, &pathLen); + normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen); + if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) { /* * The path was already normalized. Get rid of the duplicate. */ @@ -1909,16 +2005,17 @@ Tcl_FSGetNormalizedPath( fsPathPtr->normPathPtr = pathPtr; } - } else { + } + if (useThisCwd != NULL) { /* * We just need to free an object we allocated above for relative * paths (this was returned by Tcl_FSJoinToPath above), and then * of course store the cwd. */ - TclDecrRefCount(absolutePath); fsPathPtr->cwdPtr = useThisCwd; } + TclDecrRefCount(absolutePath); } return fsPathPtr->normPathPtr; @@ -1949,14 +2046,14 @@ Tcl_FSGetNormalizedPath( ClientData Tcl_FSGetInternalRep( Tcl_Obj *pathPtr, - Tcl_Filesystem *fsPtr) + const Tcl_Filesystem *fsPtr) { - FsPath* srcFsPathPtr; + FsPath *srcFsPathPtr; if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { return NULL; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); /* * We will only return the native representation for the caller's @@ -1972,7 +2069,7 @@ Tcl_FSGetInternalRep( * not easily achievable with the current implementation. */ - if (srcFsPathPtr->fsRecPtr == NULL) { + if (srcFsPathPtr->fsPtr == NULL) { /* * This only usually happens in wrappers like TclpStat which create a * string object and pass it to TclpObjStat. Code which calls the @@ -1991,8 +2088,8 @@ Tcl_FSGetInternalRep( * (e.g. from the Tcl testsuite). */ - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); - if (srcFsPathPtr->fsRecPtr == NULL) { + srcFsPathPtr = PATHOBJ(pathPtr); + if (srcFsPathPtr->fsPtr == NULL) { return NULL; } } @@ -2004,8 +2101,8 @@ Tcl_FSGetInternalRep( * for this is we ask what filesystem this path belongs to. */ - if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) { - Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr); + if (fsPtr != srcFsPathPtr->fsPtr) { + const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr); if (actualFs == fsPtr) { return Tcl_FSGetInternalRep(pathPtr, fsPtr); @@ -2017,13 +2114,13 @@ Tcl_FSGetInternalRep( Tcl_FSCreateInternalRepProc *proc; char *nativePathPtr; - proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc; + proc = srcFsPathPtr->fsPtr->createInternalRepProc; if (proc == NULL) { return NULL; } - nativePathPtr = (*proc)(pathPtr); - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + nativePathPtr = proc(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); srcFsPathPtr->nativePathPtr = nativePathPtr; } @@ -2051,15 +2148,15 @@ Tcl_FSGetInternalRep( int TclFSEnsureEpochOk( Tcl_Obj *pathPtr, - Tcl_Filesystem **fsPtrPtr) + const Tcl_Filesystem **fsPtrPtr) { - FsPath* srcFsPathPtr; + FsPath *srcFsPathPtr; if (pathPtr->typePtr != &tclFsPathType) { return TCL_OK; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); /* * Check if the filesystem has changed in some way since this object's @@ -2075,19 +2172,18 @@ TclFSEnsureEpochOk( UpdateStringOfFsPath(pathPtr); } FreeFsPathInternalRep(pathPtr); - pathPtr->typePtr = NULL; if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return TCL_ERROR; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); } /* * Check whether the object is already assigned to a fs. */ - if (srcFsPathPtr->fsRecPtr != NULL) { - *fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr; + if (srcFsPathPtr->fsPtr != NULL) { + *fsPtrPtr = srcFsPathPtr->fsPtr; } return TCL_OK; } @@ -2111,11 +2207,10 @@ TclFSEnsureEpochOk( void TclFSSetPathDetails( Tcl_Obj *pathPtr, - FilesystemRecord *fsRecPtr, + const Tcl_Filesystem *fsPtr, ClientData clientData) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - FsPath* srcFsPathPtr; + FsPath *srcFsPathPtr; /* * Make sure pathPtr is of the correct type. @@ -2127,11 +2222,10 @@ TclFSSetPathDetails( } } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); - srcFsPathPtr->fsRecPtr = fsRecPtr; + srcFsPathPtr = PATHOBJ(pathPtr); + srcFsPathPtr->fsPtr = fsPtr; srcFsPathPtr->nativePathPtr = clientData; - srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - fsRecPtr->fileRefCount++; + srcFsPathPtr->filesystemEpoch = TclFSEpoch(); } /* @@ -2156,7 +2250,7 @@ Tcl_FSEqualPaths( Tcl_Obj *firstPtr, Tcl_Obj *secondPtr) { - char *firstStr, *secondStr; + const char *firstStr, *secondStr; int firstLen, secondLen, tempErrno; if (firstPtr == secondPtr) { @@ -2166,9 +2260,9 @@ Tcl_FSEqualPaths( if (firstPtr == NULL || secondPtr == NULL) { return 0; } - firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); - secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); - if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) { + firstStr = TclGetStringFromObj(firstPtr, &firstLen); + secondStr = TclGetStringFromObj(secondPtr, &secondLen); + if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) { return 1; } @@ -2186,9 +2280,9 @@ Tcl_FSEqualPaths( return 0; } - firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); - secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); - return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0); + firstStr = TclGetStringFromObj(firstPtr, &firstLen); + secondStr = TclGetStringFromObj(secondPtr, &secondLen); + return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)); } /* @@ -2220,7 +2314,6 @@ SetFsPathFromAny( FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; @@ -2247,10 +2340,9 @@ SetFsPathFromAny( */ if (name[0] == '~') { - char *expandedUser; Tcl_DString temp; int split; - char separator='/'; + char separator = '/'; split = FindSplitPos(name, separator); if (split != len) { @@ -2270,7 +2362,7 @@ SetFsPathFromAny( * We have just '~' */ - CONST char *dir; + const char *dir; Tcl_DString dirString; if (split != len) { @@ -2280,9 +2372,11 @@ SetFsPathFromAny( dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't find HOME environment ", - "variable to expand path", (char *) NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't find HOME environment variable to" + " expand path", -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", + "HOMELESS", NULL); } return TCL_ERROR; } @@ -2297,9 +2391,10 @@ SetFsPathFromAny( Tcl_DStringInit(&temp); if (TclpGetUserHome(name+1, &temp) == NULL) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "user \"", (name+1), - "\" doesn't exist", (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "user \"%s\" doesn't exist", name+1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", + NULL); } Tcl_DStringFree(&temp); if (split != len) { @@ -2312,8 +2407,7 @@ SetFsPathFromAny( } } - expandedUser = Tcl_DStringValue(&temp); - transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp)); + transPtr = TclDStringToObj(&temp); if (split != len) { /* @@ -2358,57 +2452,38 @@ SetFsPathFromAny( transPtr = joined; } } - Tcl_DStringFree(&temp); } else { - transPtr = Tcl_FSJoinToPath(pathPtr, 0, NULL); + transPtr = TclJoinPath(1, &pathPtr); } -#if defined(__CYGWIN__) && defined(__WIN32__) - { - extern int cygwin_conv_to_win32_path(CONST char *, char *); - char winbuf[MAX_PATH+1]; - - /* - * In the Cygwin world, call conv_to_win32_path in order to use the - * mount table to translate the file name into something Windows will - * understand. Take care when converting empty strings! - */ - - name = Tcl_GetStringFromObj(transPtr, &len); - if (len > 0) { - cygwin_conv_to_win32_path(name, winbuf); - TclWinNoBackslash(winbuf); - Tcl_SetStringObj(transPtr, winbuf, -1); - } - } -#endif /* __CYGWIN__ && __WIN32__ */ - /* * Now we have a translated filename in 'transPtr'. This will have forward * slashes on Windows, and will not contain any ~user sequences. */ - fsPathPtr = (FsPath *) ckalloc((unsigned)sizeof(FsPath)); + fsPathPtr = ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = transPtr; if (transPtr != pathPtr) { Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); + /* Redo translation when $env(HOME) changes */ + fsPathPtr->filesystemEpoch = TclFSEpoch(); + } else { + fsPathPtr->filesystemEpoch = 0; } fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; - fsPathPtr->fsRecPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->fsPtr = NULL; /* * Free old representation before installing our new one. */ TclFreeIntRep(pathPtr); - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; - return TCL_OK; } @@ -2416,7 +2491,7 @@ static void FreeFsPathInternalRep( Tcl_Obj *pathPtr) /* Path object with internal rep to free. */ { - FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + FsPath *fsPathPtr = PATHOBJ(pathPtr); if (fsPathPtr->translatedPathPtr != NULL) { if (fsPathPtr->translatedPathPtr != pathPtr) { @@ -2432,26 +2507,18 @@ FreeFsPathInternalRep( if (fsPathPtr->cwdPtr != NULL) { TclDecrRefCount(fsPathPtr->cwdPtr); } - if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsRecPtr != NULL) { + if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) { Tcl_FSFreeInternalRepProc *freeProc = - fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc; + fsPathPtr->fsPtr->freeInternalRepProc; + if (freeProc != NULL) { - (*freeProc)(fsPathPtr->nativePathPtr); + freeProc(fsPathPtr->nativePathPtr); fsPathPtr->nativePathPtr = NULL; } } - if (fsPathPtr->fsRecPtr != NULL) { - fsPathPtr->fsRecPtr->fileRefCount--; - if (fsPathPtr->fsRecPtr->fileRefCount <= 0) { - /* - * It has been unregistered already. - */ - - ckfree((char *) fsPathPtr->fsRecPtr); - } - } - ckfree((char*) fsPathPtr); + ckfree(fsPathPtr); + pathPtr->typePtr = NULL; } static void @@ -2459,56 +2526,54 @@ DupFsPathInternalRep( Tcl_Obj *srcPtr, /* Path obj with internal rep to copy. */ Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */ { - FsPath* srcFsPathPtr = (FsPath*) PATHOBJ(srcPtr); - FsPath* copyFsPathPtr = (FsPath*) ckalloc((unsigned)sizeof(FsPath)); + FsPath *srcFsPathPtr = PATHOBJ(srcPtr); + FsPath *copyFsPathPtr = ckalloc(sizeof(FsPath)); - PATHOBJ(copyPtr) = (VOID *) copyFsPathPtr; + SETPATHOBJ(copyPtr, copyFsPathPtr); - if (srcFsPathPtr->translatedPathPtr != NULL) { + if (srcFsPathPtr->translatedPathPtr == srcPtr) { + /* Cycle in src -> make cycle in copy. */ + copyFsPathPtr->translatedPathPtr = copyPtr; + } else { copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; - if (copyFsPathPtr->translatedPathPtr != copyPtr) { + if (copyFsPathPtr->translatedPathPtr != NULL) { Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr); } - } else { - copyFsPathPtr->translatedPathPtr = NULL; } - if (srcFsPathPtr->normPathPtr != NULL) { + if (srcFsPathPtr->normPathPtr == srcPtr) { + /* Cycle in src -> make cycle in copy. */ + copyFsPathPtr->normPathPtr = copyPtr; + } else { copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr; - if (copyFsPathPtr->normPathPtr != copyPtr) { + if (copyFsPathPtr->normPathPtr != NULL) { Tcl_IncrRefCount(copyFsPathPtr->normPathPtr); } - } else { - copyFsPathPtr->normPathPtr = NULL; } - if (srcFsPathPtr->cwdPtr != NULL) { - copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr; + copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr; + if (copyFsPathPtr->cwdPtr != NULL) { Tcl_IncrRefCount(copyFsPathPtr->cwdPtr); - } else { - copyFsPathPtr->cwdPtr = NULL; } copyFsPathPtr->flags = srcFsPathPtr->flags; - if (srcFsPathPtr->fsRecPtr != NULL + if (srcFsPathPtr->fsPtr != NULL && srcFsPathPtr->nativePathPtr != NULL) { Tcl_FSDupInternalRepProc *dupProc = - srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc; + srcFsPathPtr->fsPtr->dupInternalRepProc; + if (dupProc != NULL) { copyFsPathPtr->nativePathPtr = - (*dupProc)(srcFsPathPtr->nativePathPtr); + dupProc(srcFsPathPtr->nativePathPtr); } else { copyFsPathPtr->nativePathPtr = NULL; } } else { copyFsPathPtr->nativePathPtr = NULL; } - copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr; + copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; - if (copyFsPathPtr->fsRecPtr != NULL) { - copyFsPathPtr->fsRecPtr->fileRefCount++; - } copyPtr->typePtr = &tclFsPathType; } @@ -2533,8 +2598,7 @@ static void UpdateStringOfFsPath( register Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { - FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); - CONST char *cwdStr; + FsPath *fsPathPtr = PATHOBJ(pathPtr); int cwdLen; Tcl_Obj *copy; @@ -2542,42 +2606,8 @@ UpdateStringOfFsPath( Tcl_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. We should never get cwdLen == 0 in this code path. - */ - - 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; - } + copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr); - Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr); pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); pathPtr->length = cwdLen; copy->bytes = tclEmptyStringRep; @@ -2639,7 +2669,7 @@ TclNativePathInFilesystem( int len; - Tcl_GetStringFromObj(pathPtr, &len); + (void) Tcl_GetStringFromObj(pathPtr, &len); if (len == 0) { /* * We reject the empty path "". |