diff options
Diffstat (limited to 'generic/tclPathObj.c')
| -rw-r--r-- | generic/tclPathObj.c | 1274 |
1 files changed, 597 insertions, 677 deletions
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index d448fbc..95c57bf 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -5,7 +5,7 @@ * to represent and manipulate a general (virtual) filesystem entity in * an efficient manner. * - * Copyright © 2003 Vince Darley. + * Copyright (c) 2003 Vince Darley. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -13,7 +13,6 @@ #include "tclInt.h" #include "tclFileSystem.h" -#include <assert.h> /* * Prototypes for functions defined later in this file. @@ -30,16 +29,13 @@ static int IsSeparatorOrNull(int ch); static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); static int MakePathFromNormalized(Tcl_Interp *interp, Tcl_Obj *pathPtr); -static int MakeTildeRelativePath(Tcl_Interp *interp, - const char *user, const char *subPath, - Tcl_DString *dsPtr); /* * Define the 'path' object type, which Tcl uses to represent file paths * internally. */ -static const Tcl_ObjType fsPathType = { +static Tcl_ObjType tclFsPathType = { "path", /* name */ FreeFsPathInternalRep, /* freeIntRepProc */ DupFsPathInternalRep, /* dupIntRepProc */ @@ -50,21 +46,46 @@ static const Tcl_ObjType fsPathType = { /* * struct FsPath -- * - * Internal representation of a Tcl_Obj of fsPathType + * Internal representation of a Tcl_Obj of "path" type. This can be used to + * represent relative or absolute paths, and has certain optimisations when + * used to represent paths which are already normalized and absolute. + * + * Note that both 'translatedPathPtr' and 'normPathPtr' can be a circular + * reference to the container Tcl_Obj of this FsPath. + * + * There are two cases, with the first being the most common: + * + * (i) flags == 0, => Ordinary path. + * + * translatedPathPtr contains the translated path (which may be a circular + * reference to the object itself). If it is NULL then the path is pure + * normalized (and the normPathPtr will be a circular reference). cwdPtr is + * null for an absolute path, and non-null for a relative path (unless the cwd + * has never been set, in which case the cwdPtr may also be null for a + * relative path). + * + * (ii) flags != 0, => Special path, see TclNewFSPathObj + * + * Now, this is a path like 'file join $dir $tail' where, cwdPtr is the $dir + * and normPathPtr is the $tail. + * */ typedef struct FsPath { - Tcl_Obj *translatedPathPtr; /* If the path has been normalized (flags == - * 0), this is NULL. Otherwise it is a path - * in which any ~user sequences have been - * translated away. */ - Tcl_Obj *normPathPtr; /* If the path has been normalized (flags == - * 0), this is an absolute path without ., .. - * or ~user components. Otherwise it is a - * path, possibly absolute, to normalize - * relative to cwdPtr. */ - Tcl_Obj *cwdPtr; /* If NULL, either translatedPtr exists or - * normPathPtr exists and is absolute. */ + Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this + * is NULL, then this is a pure normalized, + * absolute path object, in which the parent + * Tcl_Obj's string rep is already both + * translated and normalized. */ + Tcl_Obj *normPathPtr; /* Normalized absolute path, without ., .. or + * ~user sequences. If the Tcl_Obj containing + * this FsPath is already normalized, this may + * be a circular reference back to the + * container. If that is NOT the case, we have + * a refCount on the object. */ + 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. */ int flags; /* Flags to describe interpretation - see * below. */ ClientData nativePathPtr; /* Native representation of this path, which @@ -73,7 +94,7 @@ typedef struct FsPath { * generated during the correct filesystem * epoch. The epoch changes when * filesystem-mounts are changed. */ - const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */ + Tcl_Filesystem *fsPtr; /* The Tcl_Filesystem that claims this path */ } FsPath; /* @@ -88,14 +109,9 @@ typedef struct FsPath { * fields. */ -#define PATHOBJ(pathPtr) ((FsPath *) (TclFetchInternalRep((pathPtr), &fsPathType)->twoPtrValue.ptr1)) +#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1) #define SETPATHOBJ(pathPtr,fsPathPtr) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \ - ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((pathPtr), &fsPathType, &ir); \ - } while (0) + ((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr)) #define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags) /* @@ -118,17 +134,17 @@ typedef struct FsPath { * pathPtr may have a refCount of zero, or may be a shared object. * * Results: - * The result is returned in a Tcl_Obj with a refCount already - * incremented, which gives the caller ownership of it. The caller must - * arrange for Tcl_DecRefCount to be called when the object is no-longer - * needed. + * 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. * * Side effects: * None (beyond the memory allocation for the result). * * Special note: - * Originally based on code from Matt Newman and Jean-Claude Wippler. - * Totally rewritten later by Vince Darley to handle symbolic links. + * This code was originally based on code from Matt Newman and + * Jean-Claude Wippler, but has since been totally rewritten by Vince + * Darley to deal with symbolic links. * *--------------------------------------------------------------------------- */ @@ -143,17 +159,9 @@ TclFSNormalizeAbsolutePath( * directory separator - we can't use '..' to * remove the volume in a path. */ Tcl_Obj *retVal = NULL; - int zipVolumeLen; dirSep = TclGetString(pathPtr); - zipVolumeLen = TclIsZipfsPath(dirSep); - if (zipVolumeLen) { - /* - * NOTE: file normalization for zipfs is very specific to - * format of zipfs volume being of the form //xxx:/ - */ - dirSep += zipVolumeLen-1; /* Start parse after : */ - } else if (tclPlatform == TCL_PLATFORM_WINDOWS) { + if (tclPlatform == TCL_PLATFORM_WINDOWS) { if ( (dirSep[0] == '/' || dirSep[0] == '\\') && (dirSep[1] == '/' || dirSep[1] == '\\') && (dirSep[2] == '?') @@ -223,7 +231,7 @@ TclFSNormalizeAbsolutePath( retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } - TclGetStringFromObj(retVal, &curLen); + (void) Tcl_GetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } @@ -235,7 +243,7 @@ TclFSNormalizeAbsolutePath( continue; } if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) { - Tcl_Obj *linkObj; + Tcl_Obj *link; int curLen; char *linkStr; @@ -249,34 +257,29 @@ TclFSNormalizeAbsolutePath( retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } - TclGetStringFromObj(retVal, &curLen); + (void) Tcl_GetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) { - if (zipVolumeLen) { - linkObj = NULL; - } else { - linkObj = Tcl_FSLink(retVal, NULL, 0); + link = 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); - } + /* Safety check in case driver caused sharing */ + if (Tcl_IsShared(retVal)) { + TclDecrRefCount(retVal); + retVal = Tcl_DuplicateObj(retVal); + Tcl_IncrRefCount(retVal); } - if (linkObj != NULL) { + if (link != 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(linkObj) - == TCL_PATH_RELATIVE) { + if (tclPlatform != TCL_PLATFORM_WINDOWS && + Tcl_FSGetPathType(link) == TCL_PATH_RELATIVE) { /* * We need to follow this link which is relative * to retVal's directory. This means concatenating @@ -284,7 +287,7 @@ TclFSNormalizeAbsolutePath( */ const char *path = - TclGetStringFromObj(retVal, &curLen); + Tcl_GetStringFromObj(retVal, &curLen); while (--curLen >= 0) { if (IsSeparatorOrNull(path[curLen])) { @@ -297,22 +300,22 @@ TclFSNormalizeAbsolutePath( */ Tcl_SetObjLength(retVal, curLen+1); - Tcl_AppendObjToObj(retVal, linkObj); - TclDecrRefCount(linkObj); - linkStr = TclGetStringFromObj(retVal, &curLen); + Tcl_AppendObjToObj(retVal, link); + TclDecrRefCount(link); + linkStr = Tcl_GetStringFromObj(retVal, &curLen); } else { /* * Absolute link. */ TclDecrRefCount(retVal); - if (Tcl_IsShared(linkObj)) { - retVal = Tcl_DuplicateObj(linkObj); - TclDecrRefCount(linkObj); + if (Tcl_IsShared(link)) { + retVal = Tcl_DuplicateObj(link); + TclDecrRefCount(link); } else { - retVal = linkObj; + retVal = link; } - linkStr = TclGetStringFromObj(retVal, &curLen); + linkStr = Tcl_GetStringFromObj(retVal, &curLen); /* * Convert to forward-slashes on windows. @@ -329,17 +332,15 @@ TclFSNormalizeAbsolutePath( } } } else { - linkStr = TclGetStringFromObj(retVal, &curLen); + linkStr = Tcl_GetStringFromObj(retVal, &curLen); } /* - * Either way, we now remove the last path element (but - * not the first character of the path). In the case of - * zipfs, make sure not to go beyond the zipfs volume. + * Either way, we now remove the last path element. + * (but not the first character of the path) */ - int minLen = zipVolumeLen ? zipVolumeLen - 1 : 0; - while (--curLen >= minLen) { + while (--curLen >= 0) { if (IsSeparatorOrNull(linkStr[curLen])) { if (curLen) { Tcl_SetObjLength(retVal, curLen); @@ -397,22 +398,14 @@ TclFSNormalizeAbsolutePath( } /* - * Ensure a windows drive like C:/ has a trailing separator. - * Likewise for zipfs volumes. + * Ensure a windows drive like C:/ has a trailing separator */ - if (zipVolumeLen || (tclPlatform == TCL_PLATFORM_WINDOWS)) { - int needTrailingSlash = 0; + + if (tclPlatform == TCL_PLATFORM_WINDOWS) { int len; - const char *path = TclGetStringFromObj(retVal, &len); - if (zipVolumeLen) { - if (len == (zipVolumeLen - 1)) - needTrailingSlash = 1; - } else { - if (len == 2 && path[0] != 0 && path[1] == ':') { - needTrailingSlash = 1; - } - } - if (needTrailingSlash) { + const char *path = Tcl_GetStringFromObj(retVal, &len); + + if (len == 2 && path[0] != 0 && path[1] == ':') { if (Tcl_IsShared(retVal)) { TclDecrRefCount(retVal); retVal = Tcl_DuplicateObj(retVal); @@ -500,7 +493,7 @@ Tcl_FSGetPathType( Tcl_PathType TclFSGetPathType( Tcl_Obj *pathPtr, - const Tcl_Filesystem **filesystemPtrPtr, + Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr) { FsPath *fsPathPtr; @@ -518,7 +511,7 @@ TclFSGetPathType( if (PATHFLAGS(pathPtr) == 0) { /* The path is not absolute... */ -#ifdef _WIN32 +#ifdef __WIN32__ /* ... on Windows we must make another call to determine whether * it's relative or volumerelative [Bug 2571597]. */ return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, @@ -569,7 +562,7 @@ TclPathPart( Tcl_Obj *pathPtr, /* Path to take dirname of */ Tcl_PathPart portion) /* Requested portion of name */ { - if (TclHasInternalRep(pathPtr, &fsPathType)) { + if (pathPtr->typePtr == &tclFsPathType) { FsPath *fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0) { @@ -585,7 +578,7 @@ TclPathPart( int numBytes; const char *rest = - TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); + Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; @@ -623,7 +616,7 @@ TclPathPart( int numBytes; const char *rest = - TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); + Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; @@ -652,7 +645,7 @@ TclPathPart( const char *fileName, *extension; int length; - fileName = TclGetStringFromObj(fsPathPtr->normPathPtr, + fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { @@ -704,7 +697,7 @@ TclPathPart( int length; const char *fileName, *extension; - fileName = TclGetStringFromObj(pathPtr, &length); + fileName = Tcl_GetStringFromObj(pathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { Tcl_IncrRefCount(pathPtr); @@ -719,8 +712,9 @@ TclPathPart( } /* + * The behaviour we want here is slightly different to the standard * Tcl_FSSplitPath in the handling of home directories; - * Tcl_FSSplitPath preserves the "~", but this code computes the + * Tcl_FSSplitPath preserves the "~" while this code computes the * actual full path name, if we had just a single component. */ @@ -747,7 +741,7 @@ TclPathPart( (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE))) { Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &resultPtr); } else { - TclNewObj(resultPtr); + resultPtr = Tcl_NewObj(); } } else { /* @@ -785,7 +779,7 @@ GetExtension( tail = TclGetString(pathPtr); extension = TclGetExtension(tail); if (extension == NULL) { - TclNewObj(ret); + ret = Tcl_NewObj(); } else { ret = Tcl_NewStringObj(extension, -1); } @@ -834,42 +828,43 @@ Tcl_FSJoinPath( int elements) /* Number of elements to use (-1 = all) */ { Tcl_Obj *res; - int objc; - Tcl_Obj **objv; + int i; + Tcl_Filesystem *fsPtr = NULL; - if (TclListObjLength(NULL, listObj, &objc) != TCL_OK) { - return NULL; - } + if (elements < 0) { + if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) { + return NULL; + } + } else { + /* + * Just make sure it is a valid list. + */ - elements = ((elements >= 0) && (elements <= objc)) ? elements : objc; - TclListObjGetElements(NULL, listObj, &objc, &objv); - res = TclJoinPath(elements, objv, 0); - return res; -} + int listTest; -Tcl_Obj * -TclJoinPath( - int elements, /* Number of elements to use (-1 = all) */ - Tcl_Obj * const objv[], /* Path elements to join */ - int forceRelative) /* If non-zero, assume all more paths are - * relative (e.g. simple normalization) */ -{ - Tcl_Obj *res = NULL; - int i; - const Tcl_Filesystem *fsPtr = NULL; + if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) { + return NULL; + } - assert ( elements >= 0 ); + /* + * Correct this if it is too large, otherwise we will waste our time + * joining null elements to the path. + */ - if (elements == 0) { - TclNewObj(res); - return res; + if (elements > listTest) { + elements = listTest; + } } - assert ( elements > 0 ); + res = NULL; + + for (i = 0; i < elements; i++) { + Tcl_Obj *elt, *driveName = NULL; + int driveNameLength, strEltLen, length; + Tcl_PathType type; + char *strElt, *ptr; - if (elements == 2) { - Tcl_Obj *elt = objv[0]; - Tcl_ObjInternalRep *eltIr = TclFetchInternalRep(elt, &fsPathType); + Tcl_ListObjIndex(NULL, listObj, i, &elt); /* * This is a special case where we can be much more efficient, where @@ -878,25 +873,19 @@ TclJoinPath( * object which can be normalized more efficiently. Currently we only * use the special case when we have exactly two elements, but we * could expand that in the future. - * - * Bugfix [a47641a0]. TclNewFSPathObj requires first argument - * to be an absolute path. Added a check to ensure that elt is absolute. */ - if ((eltIr) - && !((elt->bytes != NULL) && (elt->bytes[0] == '\0')) - && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) { - Tcl_Obj *tailObj = objv[1]; - Tcl_PathType type; + if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType) + && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) { + Tcl_Obj *tail; - /* if forceRelative - second path is relative */ - type = forceRelative ? TCL_PATH_RELATIVE : - TclGetPathType(tailObj, NULL, NULL, NULL); + Tcl_ListObjIndex(NULL, listObj, i+1, &tail); + type = TclGetPathType(tail, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { const char *str; int len; - str = TclGetStringFromObj(tailObj, &len); + str = Tcl_GetStringFromObj(tail, &len); if (len == 0) { /* * This happens if we try to handle the root volume '/'. @@ -904,11 +893,14 @@ TclJoinPath( * the base itself is just fine! */ + if (res != NULL) { + TclDecrRefCount(res); + } return elt; } /* - * If it doesn't begin with '.' and is a Unix path or it a + * If it doesn't begin with '.' and is a unix path or it a * windows path without backslashes, then we can be very * efficient here. (In fact even a windows path with * backslashes can be joined efficiently, but the path object @@ -926,17 +918,10 @@ TclJoinPath( if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (strchr(Tcl_GetString(elt), '\\') == NULL)) { - - if (PATHFLAGS(elt)) { - return TclNewFSPathObj(elt, str, len); - } - if (TCL_PATH_ABSOLUTE != Tcl_FSGetPathType(elt)) { - return TclNewFSPathObj(elt, str, len); - } - (void) Tcl_FSGetNormalizedPath(NULL, elt); - if (elt == PATHOBJ(elt)->normPathPtr) { - return TclNewFSPathObj(elt, str, len); + if (res != NULL) { + TclDecrRefCount(res); } + return TclNewFSPathObj(elt, str, len); } } @@ -945,33 +930,25 @@ TclJoinPath( * more general code below handle things. */ } else if (tclPlatform == TCL_PLATFORM_UNIX) { - return tailObj; + if (res != NULL) { + TclDecrRefCount(res); + } + return tail; } else { - const char *str = TclGetString(tailObj); + const char *str = TclGetString(tail); if (tclPlatform == TCL_PLATFORM_WINDOWS) { if (strchr(str, '\\') == NULL) { - return tailObj; + if (res != NULL) { + TclDecrRefCount(res); + } + return tail; } } } } - } - - assert ( res == NULL ); - - for (i = 0; i < elements; i++) { - int driveNameLength, strEltLen, length; - Tcl_PathType type; - char *strElt, *ptr; - Tcl_Obj *driveName = NULL; - Tcl_Obj *elt = objv[i]; - - strElt = TclGetStringFromObj(elt, &strEltLen); - driveNameLength = 0; - /* if forceRelative - all paths excepting first one are relative */ - type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE : - TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName); + strElt = Tcl_GetStringFromObj(elt, &strEltLen); + type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { /* * Zero out the current result. @@ -1026,12 +1003,6 @@ TclJoinPath( } } ptr = strElt; - /* [Bug f34cf83dd0] */ - if (driveNameLength > 0) { - if (ptr[0] == '/' && ptr[-1] == '/') { - goto noQuickReturn; - } - } while (*ptr != '\0') { if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) { /* @@ -1048,8 +1019,8 @@ TclJoinPath( } /* - * 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; @@ -1062,9 +1033,11 @@ TclJoinPath( noQuickReturn: if (res == NULL) { - TclNewObj(res); + res = Tcl_NewObj(); + ptr = Tcl_GetStringFromObj(res, &length); + } else { + ptr = Tcl_GetStringFromObj(res, &length); } - ptr = TclGetStringFromObj(res, &length); /* * Strip off any './' before a tilde, unless this is the beginning of @@ -1093,11 +1066,10 @@ TclJoinPath( 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]; - TclDecrRefCount(sep); } /* Safety check in case the VFS driver caused sharing */ if (Tcl_IsShared(res)) { @@ -1109,7 +1081,7 @@ TclJoinPath( if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); - TclGetStringFromObj(res, &length); + Tcl_GetStringFromObj(res, &length); } Tcl_SetObjLength(res, length + (int) strlen(strElt)); @@ -1133,7 +1105,9 @@ TclJoinPath( Tcl_SetObjLength(res, length); } } - assert ( res != NULL ); + if (res == NULL) { + res = Tcl_NewObj(); + } return res; } @@ -1175,16 +1149,39 @@ Tcl_FSConvertToPathType( * path. */ - if (TclHasInternalRep(pathPtr, &fsPathType)) { + if (pathPtr->typePtr == &tclFsPathType) { if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) { return TCL_OK; } - TclGetString(pathPtr); - Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL); + if (pathPtr->bytes == NULL) { + UpdateStringOfFsPath(pathPtr); + } + FreeFsPathInternalRep(pathPtr); } - return SetFsPathFromAny(interp, pathPtr); + return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + + /* + * 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. + */ } /* @@ -1298,8 +1295,8 @@ TclNewFSPathObj( return pathPtr; } - TclNewObj(pathPtr); - fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + pathPtr = Tcl_NewObj(); + fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); /* * Set up the path. @@ -1316,46 +1313,47 @@ TclNewFSPathObj( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = TCLPATH_APPENDED; - TclInvalidateStringRep(pathPtr); + 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. + * 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; - } - break; - case 1: /* Scanning for next dirsep */ - switch (*p) { - case '/': - case '\\': - case ':': - state = 0; - break; - } - } + 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; + PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM; } return pathPtr; @@ -1375,10 +1373,10 @@ AppendPath( * 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 - * internalrep produce the same results; that is, bugward compatibility. If - * we need to fix that bug here, it needs fixing in TclJoinPath() too. + * intrep produce the same results; that is, bugward compatibility. If + * we need to fix that bug here, it needs fixing in Tcl_FSJoinPath() too. */ - bytes = TclGetStringFromObj(tail, &numBytes); + bytes = Tcl_GetStringFromObj(tail, &numBytes); if (numBytes == 0) { Tcl_AppendToObj(copy, "/", 1); } else { @@ -1411,19 +1409,82 @@ AppendPath( Tcl_Obj * TclFSMakePathRelative( - TCL_UNUSED(Tcl_Interp *), + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr, /* The path we have. */ Tcl_Obj *cwdPtr) /* Make it relative to this. */ { int cwdLen, len; const char *tempStr; - Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(pathPtr, &fsPathType); - if (irPtr) { + if (pathPtr->typePtr == &tclFsPathType) { FsPath *fsPathPtr = PATHOBJ(pathPtr); - if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { - return fsPathPtr->normPathPtr; + if (PATHFLAGS(pathPtr) != 0 + && fsPathPtr->cwdPtr == cwdPtr) { + pathPtr = fsPathPtr->normPathPtr; + + /* TODO: Determine how much, if any, of this forcing + * the relative path tail into the "path" Tcl_ObjType + * with a recorded cwdPtr context has any actual value. + * + * Nothing is getting cached. Not normPathPtr, not nativePathPtr, + * nor fsPtr, so storing the cwdPtr context against which such + * cached values might later be validated appears to be of no + * value. Take that away, and all this code is just a mildly + * optimized equivalent of a call to SetFsPathFromAny(). That + * optimization may have some value, *if* these value in fact + * get used as "path" values before used as something else. + * If not, though, whatever cost we pay below to convert to + * one of the "path" intreps is just a waste, it seems. The + * usual convention in the core is to delay ObjType conversion + * until it is needed and demanded, and I don't see why this + * section of code should be an exception to that. Leaving it + * in place for the rest of the 8.5.* releases just for sake + * of stability. + */ + + /* + * 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", NULL); + } + return NULL; + } + pathPtr->typePtr->updateStringProc(pathPtr); + } + TclFreeIntRep(pathPtr); + } + + /* + * Now pathPtr is a string object. + */ + + fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); + + /* + * Circular reference, by design. + */ + + fsPathPtr->translatedPathPtr = pathPtr; + fsPathPtr->normPathPtr = NULL; + fsPathPtr->cwdPtr = cwdPtr; + Tcl_IncrRefCount(cwdPtr); + fsPathPtr->nativePathPtr = NULL; + fsPathPtr->fsPtr = NULL; + fsPathPtr->filesystemEpoch = 0; + + SETPATHOBJ(pathPtr, fsPathPtr); + PATHFLAGS(pathPtr) = 0; + pathPtr->typePtr = &tclFsPathType; + + return pathPtr; } } @@ -1438,7 +1499,7 @@ TclFSMakePathRelative( * too little below, leading to wrong answers returned by glob. */ - tempStr = TclGetStringFromObj(cwdPtr, &cwdLen); + tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen); /* * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the @@ -1458,7 +1519,7 @@ TclFSMakePathRelative( } break; } - tempStr = TclGetStringFromObj(pathPtr, &len); + tempStr = Tcl_GetStringFromObj(pathPtr, &len); return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen); } @@ -1482,16 +1543,35 @@ TclFSMakePathRelative( static int MakePathFromNormalized( - TCL_UNUSED(Tcl_Interp *), + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; - if (TclHasInternalRep(pathPtr, &fsPathType)) { + if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; } - fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + /* + * 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", NULL); + } + return TCL_ERROR; + } + pathPtr->typePtr->updateStringProc(pathPtr); + } + TclFreeIntRep(pathPtr); + } + + fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); /* * It's a pure normalized absolute path. @@ -1499,7 +1579,11 @@ MakePathFromNormalized( fsPathPtr->translatedPathPtr = NULL; - Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr)); + /* + * Circular reference by design. + */ + + fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; @@ -1508,6 +1592,7 @@ MakePathFromNormalized( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; + pathPtr->typePtr = &tclFsPathType; return TCL_OK; } @@ -1517,7 +1602,7 @@ MakePathFromNormalized( * * Tcl_FSNewNativePath -- * - * Performs the something like the reverse of the usual + * This function performs the something like the reverse of the usual * obj->path->nativerep conversions. If some code retrieves a path in * native form (from, e.g. readlink or a native dialog), and that path is * to be used at the Tcl level, then calling this function is an @@ -1539,7 +1624,7 @@ MakePathFromNormalized( Tcl_Obj * Tcl_FSNewNativePath( - const Tcl_Filesystem *fromFilesystem, + Tcl_Filesystem *fromFilesystem, ClientData clientData) { Tcl_Obj *pathPtr = NULL; @@ -1558,12 +1643,25 @@ Tcl_FSNewNativePath( * safe. */ - Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL); - fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + if (pathPtr->typePtr != NULL) { + if (pathPtr->bytes == NULL) { + if (pathPtr->typePtr->updateStringProc == NULL) { + return NULL; + } + pathPtr->typePtr->updateStringProc(pathPtr); + } + TclFreeIntRep(pathPtr); + } + + fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; - Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr)); + /* + * Circular reference, by design. + */ + + fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; fsPathPtr->fsPtr = fromFilesystem; @@ -1571,6 +1669,7 @@ Tcl_FSNewNativePath( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; + pathPtr->typePtr = &tclFsPathType; return pathPtr; } @@ -1580,18 +1679,16 @@ Tcl_FSNewNativePath( * * Tcl_FSGetTranslatedPath -- * - * Attempts to extract the translated path from the given + * This function attempts to extract the translated path from the given * Tcl_Obj. If the translation succeeds (i.e. the object is a valid - * path), then it is returned. Otherwise NULL is returned and an - * error message may be left in the interpreter if it is not NULL. + * path), then it is returned. Otherwise NULL will be returned, and an + * error message may be left in the interpreter (if it is non-NULL) * * Results: - * A Tcl_Obj pointer or NULL. + * NULL or a valid Tcl_Obj pointer. * * Side effects: - * pathPtr is converted to fsPathType if necessary. - * - * FsPath members are modified as needed. + * Only those of 'Tcl_FSConvertToPathType' * *--------------------------------------------------------------------------- */ @@ -1609,12 +1706,7 @@ Tcl_FSGetTranslatedPath( } srcFsPathPtr = PATHOBJ(pathPtr); if (srcFsPathPtr->translatedPathPtr == NULL) { - if (PATHFLAGS(pathPtr) == 0) { - /* - * Path is already normalized - */ - retObj = srcFsPathPtr->normPathPtr; - } else { + if (PATHFLAGS(pathPtr) != 0) { /* * We lack a translated path result, but we have a directory * (cwdPtr) and a tail (normPathPtr), and if we join the @@ -1624,23 +1716,29 @@ Tcl_FSGetTranslatedPath( Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp, srcFsPathPtr->cwdPtr); - Tcl_ObjInternalRep *translatedCwdIrPtr; - if (translatedCwdPtr == NULL) { return NULL; } retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1, - &srcFsPathPtr->normPathPtr); - Tcl_IncrRefCount(srcFsPathPtr->translatedPathPtr = retObj); - translatedCwdIrPtr = TclFetchInternalRep(translatedCwdPtr, &fsPathType); - if (translatedCwdIrPtr) { + &(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 + * something like being a 'pure list'. The object's string, + * translatedPath and normalizedPath are all identical. + */ + + retObj = srcFsPathPtr->normPathPtr; } } else { /* @@ -1684,10 +1782,10 @@ Tcl_FSGetTranslatedStringPath( if (transPtr != NULL) { int len; - const char *orig = TclGetStringFromObj(transPtr, &len); - char *result = (char *)ckalloc(len+1); + const char *orig = Tcl_GetStringFromObj(transPtr, &len); + char *result = (char *) ckalloc((unsigned) len+1); - memcpy(result, orig, len+1); + memcpy(result, orig, (size_t) len+1); TclDecrRefCount(transPtr); return result; } @@ -1741,9 +1839,11 @@ Tcl_FSGetNormalizedPath( return NULL; } /* TODO: Figure out why this is needed. */ - TclGetString(pathPtr); + if (pathPtr->bytes == NULL) { + UpdateStringOfFsPath(pathPtr); + } - TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen); + Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen); if (tailLen) { copy = AppendPath(dir, fsPathPtr->normPathPtr); } else { @@ -1756,34 +1856,35 @@ Tcl_FSGetNormalizedPath( * We now own a reference on both 'dir' and 'copy' */ - (void) TclGetStringFromObj(dir, &cwdLen); + (void) Tcl_GetStringFromObj(dir, &cwdLen); + cwdLen += (Tcl_GetString(copy)[cwdLen] == '/'); /* Normalize the combined string. */ 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] ... + * 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] ... */ Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy); - 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' 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. + * ... 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. */ - TclFSNormalizeToUniquePath(interp, copy, cwdLen); + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1); } /* Now we need to construct the new path object. */ @@ -1793,11 +1894,11 @@ Tcl_FSGetNormalizedPath( /* * NOTE: here we are (dangerously?) assuming that origDir points - * to a Tcl_Obj with Tcl_ObjType == &fsPathType. The + * 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. + * 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); @@ -1808,6 +1909,10 @@ Tcl_FSGetNormalizedPath( TclDecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; + /* + * That's our reference to copy used. + */ + TclDecrRefCount(dir); TclDecrRefCount(origDir); } else { @@ -1816,6 +1921,10 @@ Tcl_FSGetNormalizedPath( TclDecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; + /* + * That's our reference to copy used. + */ + TclDecrRefCount(dir); } PATHFLAGS(pathPtr) = 0; @@ -1827,9 +1936,11 @@ Tcl_FSGetNormalizedPath( if (fsPathPtr->cwdPtr != NULL) { if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { - TclGetString(pathPtr); - Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL); - if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) { + if (pathPtr->bytes == NULL) { + UpdateStringOfFsPath(pathPtr); + } + FreeFsPathInternalRep(pathPtr); + if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) { return NULL; } fsPathPtr = PATHOBJ(pathPtr); @@ -1839,7 +1950,7 @@ Tcl_FSGetNormalizedPath( copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); - (void) TclGetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); + (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); cwdLen += (Tcl_GetString(copy)[cwdLen] == '/'); /* @@ -1854,9 +1965,10 @@ Tcl_FSGetNormalizedPath( } if (fsPathPtr->normPathPtr == NULL) { Tcl_Obj *useThisCwd = NULL; + int pureNormalized = 1; /* - * Since normPathPtr is NULL but this is a valid path object, we know + * Since normPathPtr is NULL, but this is a valid path object, we know * that the translatedPathPtr cannot be NULL. */ @@ -1874,11 +1986,11 @@ Tcl_FSGetNormalizedPath( 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. + * 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. @@ -1903,6 +2015,7 @@ Tcl_FSGetNormalizedPath( return NULL; } + pureNormalized = 0; Tcl_DecrRefCount(absolutePath); absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); Tcl_IncrRefCount(absolutePath); @@ -1910,7 +2023,7 @@ Tcl_FSGetNormalizedPath( /* * We have a refCount on the cwd. */ -#ifdef _WIN32 +#ifdef __WIN32__ } else if (type == TCL_PATH_VOLUME_RELATIVE) { /* * Only Windows has volume-relative paths. @@ -1922,7 +2035,8 @@ Tcl_FSGetNormalizedPath( if (absolutePath == NULL) { return NULL; } -#endif /* _WIN32 */ + pureNormalized = 0; +#endif /* __WIN32__ */ } } @@ -1930,12 +2044,31 @@ Tcl_FSGetNormalizedPath( * Already has refCount incremented. */ - if (fsPathPtr->normPathPtr) { - Tcl_DecrRefCount(fsPathPtr->normPathPtr); - } fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath); + /* + * Check if path is pure normalized (this can only be the case if it + * is an absolute path). + */ + + if (pureNormalized) { + if (!strcmp(TclGetString(fsPathPtr->normPathPtr), + TclGetString(pathPtr))) { + /* + * The path was already normalized. Get rid of the duplicate. + */ + + TclDecrRefCount(fsPathPtr->normPathPtr); + + /* + * We do *not* increment the refCount for this circular + * reference. + */ + + fsPathPtr->normPathPtr = pathPtr; + } + } if (useThisCwd != NULL) { /* * We just need to free an object we allocated above for relative @@ -1956,23 +2089,19 @@ Tcl_FSGetNormalizedPath( * * Tcl_FSGetInternalRep -- * - * Produces a native representation of a given path object in the given - * filesystem. + * Extract the internal representation of a given path object, in the + * given filesystem. If the path object belongs to a different + * filesystem, we return NULL. * - * In the future it might be desirable to have separate versions - * of this function with different signatures, for example - * Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc. Right now, since - * native paths are all string based, we use just one function. + * If the internal representation is currently NULL, we attempt to + * generate it, by calling the filesystem's + * 'Tcl_FSCreateInternalRepProc'. * * Results: - * - * The native handle for the path, or NULL if the path is not handled by - * the given filesystem + * NULL or a valid internal representation. * * Side effects: - * - * Tcl_FSCreateInternalRepProc if needed to produce the native - * handle, which is then stored in the internal representation of pathPtr. + * An attempt may be made to convert the object. * *--------------------------------------------------------------------------- */ @@ -1980,7 +2109,7 @@ Tcl_FSGetNormalizedPath( ClientData Tcl_FSGetInternalRep( Tcl_Obj *pathPtr, - const Tcl_Filesystem *fsPtr) + Tcl_Filesystem *fsPtr) { FsPath *srcFsPathPtr; @@ -1990,36 +2119,49 @@ Tcl_FSGetInternalRep( srcFsPathPtr = PATHOBJ(pathPtr); /* - * Currently there must be a unique bi-directional mapping between a path - * and a filesystem, and therefore there is no way to "remap" a file, i.e., - * to map a file in one filesystem into another. Another way of putting - * this is that 'stacked' filesystems are not allowed. It could be useful - * in the future to redesign the system to allow that. + * We will only return the native representation for the caller's + * filesystem. Otherwise we will simply return NULL. This means that there + * must be a unique bi-directional mapping between paths and filesystems, + * and that this mapping will not allow 'remapped' files -- files which + * are in one filesystem but mapped into another. Another way of putting + * this is that 'stacked' filesystems are not allowed. We recognise that + * this is a potentially useful feature for the future. * * Even something simple like a 'pass through' filesystem which logs all * activity and passes the calls onto the native system would be nice, but - * not currently easily achievable. + * not easily achievable with the current implementation. */ 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 + * Tcl_FS.. functions should always have a filesystem already set. + * Whether this code path is legal or not depends on whether we decide + * to allow external code to call the native filesystem directly. It + * is at least safer to allow this sub-optimal routing. + */ + Tcl_FSGetFileSystemForPath(pathPtr); + /* + * If we fail through here, then the path is probably not a valid path + * in the filesystsem, and is most likely to be a use of the empty + * path "" via a direct call to one of the objectified interfaces + * (e.g. from the Tcl testsuite). + */ + srcFsPathPtr = PATHOBJ(pathPtr); if (srcFsPathPtr->fsPtr == NULL) { - /* - * The path is probably not a valid path in the filesystsem, and is - * most likely to be a use of the empty path "" via a direct call - * to one of the objectified interfaces (e.g. from the Tcl - * testsuite). - */ return NULL; } } /* - * If the file belongs to a different filesystem, perhaps it is actually - * linked through to a file in the given filesystem. Check this by - * inspecting the filesystem associated with the given path. + * There is still one possibility we should consider; if the file belongs + * to a different filesystem, perhaps it is actually linked through to a + * file in our own filesystem which we do care about. The way we can check + * for this is we ask what filesystem this path belongs to. */ if (fsPtr != srcFsPathPtr->fsPtr) { @@ -2040,10 +2182,9 @@ Tcl_FSGetInternalRep( return NULL; } - nativePathPtr = (char *)proc(pathPtr); + nativePathPtr = (*proc)(pathPtr); srcFsPathPtr = PATHOBJ(pathPtr); srcFsPathPtr->nativePathPtr = nativePathPtr; - srcFsPathPtr->filesystemEpoch = TclFSEpoch(); } return srcFsPathPtr->nativePathPtr; @@ -2054,15 +2195,15 @@ Tcl_FSGetInternalRep( * * TclFSEnsureEpochOk -- * - * Ensure that the path is a valid path, and that it has a - * fsPathType internal representation that is not stale. + * This will ensure the pathPtr is up to date and can be converted into a + * "path" type, and that we are able to generate a complete normalized + * path which is used to determine the filesystem match. * * Results: - * A standard Tcl return code. + * Standard Tcl return code. * * Side effects: - * The internal representation of fsPtrPtr is converted to fsPathType if - * possible. + * An attempt may be made to convert the object. * *--------------------------------------------------------------------------- */ @@ -2070,35 +2211,41 @@ Tcl_FSGetInternalRep( int TclFSEnsureEpochOk( Tcl_Obj *pathPtr, - const Tcl_Filesystem **fsPtrPtr) + Tcl_Filesystem **fsPtrPtr) { FsPath *srcFsPathPtr; - if (!TclHasInternalRep(pathPtr, &fsPathType)) { + if (pathPtr->typePtr != &tclFsPathType) { return TCL_OK; } srcFsPathPtr = PATHOBJ(pathPtr); + /* + * Check if the filesystem has changed in some way since this object's + * internal representation was calculated. + */ + if (!TclFSEpochOk(srcFsPathPtr->filesystemEpoch)) { /* - * The filesystem has changed in some way since the internal - * representation for this object was calculated. Discard the stale - * representation and recalculate it. + * We have to discard the stale representation and recalculate it. */ - TclGetString(pathPtr); - Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL); + if (pathPtr->bytes == NULL) { + UpdateStringOfFsPath(pathPtr); + } + FreeFsPathInternalRep(pathPtr); if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return TCL_ERROR; } srcFsPathPtr = PATHOBJ(pathPtr); } + /* + * Check whether the object is already assigned to a fs. + */ + if (srcFsPathPtr->fsPtr != NULL) { - /* - * There is already a filesystem assigned to this path. - */ *fsPtrPtr = srcFsPathPtr->fsPtr; } return TCL_OK; @@ -2123,7 +2270,7 @@ TclFSEnsureEpochOk( void TclFSSetPathDetails( Tcl_Obj *pathPtr, - const Tcl_Filesystem *fsPtr, + Tcl_Filesystem *fsPtr, ClientData clientData) { FsPath *srcFsPathPtr; @@ -2132,7 +2279,7 @@ TclFSSetPathDetails( * Make sure pathPtr is of the correct type. */ - if (!TclHasInternalRep(pathPtr, &fsPathType)) { + if (pathPtr->typePtr != &tclFsPathType) { if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return; } @@ -2166,7 +2313,7 @@ Tcl_FSEqualPaths( Tcl_Obj *firstPtr, Tcl_Obj *secondPtr) { - const char *firstStr, *secondStr; + char *firstStr, *secondStr; int firstLen, secondLen, tempErrno; if (firstPtr == secondPtr) { @@ -2176,9 +2323,9 @@ Tcl_FSEqualPaths( if (firstPtr == NULL || secondPtr == NULL) { return 0; } - firstStr = TclGetStringFromObj(firstPtr, &firstLen); - secondStr = TclGetStringFromObj(secondPtr, &secondLen); - if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) { + firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); + secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); + if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) { return 1; } @@ -2196,9 +2343,9 @@ Tcl_FSEqualPaths( return 0; } - firstStr = TclGetStringFromObj(firstPtr, &firstLen); - secondStr = TclGetStringFromObj(secondPtr, &secondLen); - return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)); + firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); + secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); + return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0); } /* @@ -2206,12 +2353,11 @@ Tcl_FSEqualPaths( * * SetFsPathFromAny -- * - * Attempt to convert the internal representation of pathPtr to - * fsPathType. + * This function tries to convert the given Tcl_Obj to a valid Tcl path + * type. * - * A tilde ("~") character at the beginnig of the filename indicates the - * current user's home directory, and "~<user>" indicates a particular - * user's directory. + * The filename may begin with "~" (to indicate current user's home + * directory) or "~<user>" (to indicate any user's home directory). * * Results: * Standard Tcl error code. @@ -2230,9 +2376,9 @@ SetFsPathFromAny( int len; FsPath *fsPathPtr; Tcl_Obj *transPtr; - const char *name; + char *name; - if (TclHasInternalRep(pathPtr, &fsPathType)) { + if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; } @@ -2250,43 +2396,49 @@ SetFsPathFromAny( * cmdAH.test exercise most of the code). */ - name = TclGetStringFromObj(pathPtr, &len); + name = Tcl_GetStringFromObj(pathPtr, &len); /* * Handle tilde substitutions, if needed. */ - if (len && name[0] == '~') { + if (name[0] == '~') { + char *expandedUser; Tcl_DString temp; int split; char separator = '/'; - /* - * We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc. - * split becomes value 1 for '~/...' as well as for '~'. - */ split = FindSplitPos(name, separator); + if (split != len) { + /* + * We have multiple pieces '~user/foo/bar...' + */ + + name[split] = '\0'; + } /* * Do some tilde substitution. */ - if (split == 1) { + if (name[1] == '\0') { /* - * We have just '~' (or '~/...') + * We have just '~' */ const char *dir; Tcl_DString dirString; + if (split != len) { + name[split] = separator; + } + dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment variable to" - " expand path", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", - "HOMELESS", (void *)NULL); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "couldn't find HOME environment " + "variable to expand path", NULL); } return TCL_ERROR; } @@ -2295,32 +2447,29 @@ SetFsPathFromAny( Tcl_DStringFree(&dirString); } else { /* - * There is a '~user' + * We have a user name '~user' */ - const char *expandedUser; - Tcl_DString userName; - - Tcl_DStringInit(&userName); - Tcl_DStringAppend(&userName, name+1, split-1); - expandedUser = Tcl_DStringValue(&userName); - Tcl_DStringInit(&temp); - if (TclpGetUserHome(expandedUser, &temp) == NULL) { + if (TclpGetUserHome(name+1, &temp) == NULL) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", expandedUser)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", - (void *)NULL); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "user \"", name+1, + "\" doesn't exist", NULL); } - Tcl_DStringFree(&userName); Tcl_DStringFree(&temp); + if (split != len) { + name[split] = separator; + } return TCL_ERROR; } - Tcl_DStringFree(&userName); + if (split != len) { + name[split] = separator; + } } - transPtr = Tcl_DStringToObj(&temp); + expandedUser = Tcl_DStringValue(&temp); + transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp)); if (split != len) { /* @@ -2338,7 +2487,7 @@ SetFsPathFromAny( Tcl_Obj **objv; Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL); - TclListObjGetElements(NULL, parts, &objc, &objv); + Tcl_ListObjGetElements(NULL, parts, &objc, &objv); /* * Skip '~'. It's replaced by its expansion. @@ -2350,21 +2499,27 @@ SetFsPathFromAny( } TclDecrRefCount(parts); } else { - Tcl_Obj *pair[2]; + /* + * Simple case. "rest" is relative path. Just join it. The + * "rest" object will be freed when Tcl_FSJoinToPath returns + * (unless something else claims a refCount on it). + */ - pair[0] = transPtr; - pair[1] = Tcl_NewStringObj(name+split+1, -1); - transPtr = TclJoinPath(2, pair, 1); - if (transPtr != pair[0]) { - Tcl_DecrRefCount(pair[0]); - } - if (transPtr != pair[1]) { - Tcl_DecrRefCount(pair[1]); - } + Tcl_Obj *joined; + Tcl_Obj *rest = Tcl_NewStringObj(name+split+1, -1); + + Tcl_IncrRefCount(transPtr); + joined = Tcl_FSJoinToPath(transPtr, 1, &rest); + TclDecrRefCount(transPtr); + transPtr = joined; } } + Tcl_DStringFree(&temp); } else { - transPtr = TclJoinPath(1, &pathPtr, 1); + /* Bug 3479689: protect 0-refcount pathPth from getting freed */ + pathPtr->refCount++; + transPtr = Tcl_FSJoinToPath(pathPtr, 0, NULL); + pathPtr->refCount--; } /* @@ -2372,25 +2527,29 @@ SetFsPathFromAny( * slashes on Windows, and will not contain any ~user sequences. */ - fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); - if (transPtr == pathPtr) { - (void)TclGetString(pathPtr); - TclFreeInternalRep(pathPtr); - transPtr = Tcl_DuplicateObj(pathPtr); - fsPathPtr->filesystemEpoch = 0; + fsPathPtr->translatedPathPtr = transPtr; + if (transPtr != pathPtr) { + Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); + /* Redo translation when $env(HOME) changes */ + fsPathPtr->filesystemEpoch = TclFSEpoch(); } else { - fsPathPtr->filesystemEpoch = TclFSEpoch(); + fsPathPtr->filesystemEpoch = 0; } - Tcl_IncrRefCount(transPtr); - fsPathPtr->translatedPathPtr = transPtr; fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; + /* + * Free old representation before installing our new one. + */ + + TclFreeIntRep(pathPtr); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; + pathPtr->typePtr = &tclFsPathType; return TCL_OK; } @@ -2413,19 +2572,19 @@ FreeFsPathInternalRep( } if (fsPathPtr->cwdPtr != NULL) { TclDecrRefCount(fsPathPtr->cwdPtr); - fsPathPtr->cwdPtr = NULL; } if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) { Tcl_FSFreeInternalRepProc *freeProc = fsPathPtr->fsPtr->freeInternalRepProc; if (freeProc != NULL) { - freeProc(fsPathPtr->nativePathPtr); + (*freeProc)(fsPathPtr->nativePathPtr); fsPathPtr->nativePathPtr = NULL; } } - ckfree(fsPathPtr); + ckfree((char *) fsPathPtr); + pathPtr->typePtr = NULL; } static void @@ -2434,18 +2593,28 @@ DupFsPathInternalRep( Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */ { FsPath *srcFsPathPtr = PATHOBJ(srcPtr); - FsPath *copyFsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + FsPath *copyFsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); SETPATHOBJ(copyPtr, copyFsPathPtr); - copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; - if (copyFsPathPtr->translatedPathPtr != NULL) { - Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr); + if (srcFsPathPtr->translatedPathPtr == srcPtr) { + /* Cycle in src -> make cycle in copy. */ + copyFsPathPtr->translatedPathPtr = copyPtr; + } else { + copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; + if (copyFsPathPtr->translatedPathPtr != NULL) { + Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr); + } } - copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr; - if (copyFsPathPtr->normPathPtr != NULL) { - Tcl_IncrRefCount(copyFsPathPtr->normPathPtr); + if (srcFsPathPtr->normPathPtr == srcPtr) { + /* Cycle in src -> make cycle in copy. */ + copyFsPathPtr->normPathPtr = copyPtr; + } else { + copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr; + if (copyFsPathPtr->normPathPtr != NULL) { + Tcl_IncrRefCount(copyFsPathPtr->normPathPtr); + } } copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr; @@ -2462,7 +2631,7 @@ DupFsPathInternalRep( if (dupProc != NULL) { copyFsPathPtr->nativePathPtr = - dupProc(srcFsPathPtr->nativePathPtr); + (*dupProc)(srcFsPathPtr->nativePathPtr); } else { copyFsPathPtr->nativePathPtr = NULL; } @@ -2471,6 +2640,8 @@ DupFsPathInternalRep( } copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; + + copyPtr->typePtr = &tclFsPathType; } /* @@ -2491,7 +2662,7 @@ DupFsPathInternalRep( static void UpdateStringOfFsPath( - Tcl_Obj *pathPtr) /* path obj with string rep to update. */ + register Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); int cwdLen; @@ -2502,15 +2673,11 @@ UpdateStringOfFsPath( } copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr); - if (Tcl_IsShared(copy)) { - copy = Tcl_DuplicateObj(copy); - } - Tcl_IncrRefCount(copy); - /* Steal copy's string rep */ - pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen); + pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); pathPtr->length = cwdLen; - TclInitEmptyStringRep(copy); + copy->bytes = tclEmptyStringRep; + copy->length = 0; TclDecrRefCount(copy); } @@ -2538,7 +2705,7 @@ UpdateStringOfFsPath( int TclNativePathInFilesystem( Tcl_Obj *pathPtr, - TCL_UNUSED(ClientData *)) + ClientData *clientDataPtr) { /* * A special case is required to handle the empty path "". This is a valid @@ -2547,7 +2714,7 @@ TclNativePathInFilesystem( * semantics of Tcl (at present anyway), so we have to abide by them here. */ - if (TclHasInternalRep(pathPtr, &fsPathType)) { + if (pathPtr->typePtr == &tclFsPathType) { if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') { /* * We reject the empty path "". @@ -2562,13 +2729,13 @@ TclNativePathInFilesystem( } else { /* * It is somewhat unusual to reach this code path without the object - * being of fsPathType. However, we do our best to deal with the + * being of tclFsPathType. However, we do our best to deal with the * situation. */ int len; - (void) TclGetStringFromObj(pathPtr, &len); + (void) Tcl_GetStringFromObj(pathPtr, &len); if (len == 0) { /* * We reject the empty path "". @@ -2586,253 +2753,6 @@ TclNativePathInFilesystem( } /* - *---------------------------------------------------------------------- - * - * MakeTildeRelativePath -- - * - * Returns a path relative to the home directory of a user. - * Note there is a difference between not specifying a user and - * explicitly specifying the current user. This mimics Tcl8's tilde - * expansion. - * - * The subPath argument is joined to the expanded home directory - * as in Tcl_JoinPath. This means if it is not relative, it will - * returned as the result with the home directory only checked - * for user name validity. - * - * Results: - * Returns TCL_OK on success with home directory path in *dsPtr - * and TCL_ERROR on failure with error message in interp if non-NULL. - * - *---------------------------------------------------------------------- - */ -int -MakeTildeRelativePath( - Tcl_Interp *interp, /* May be NULL. Only used for error messages */ - const char *user, /* User name. NULL -> current user */ - const char *subPath, /* Rest of path. May be NULL */ - Tcl_DString *dsPtr) /* Output. Is initialized by the function. Must be - freed on success */ -{ - const char *dir; - Tcl_DString dirString; - - Tcl_DStringInit(dsPtr); - Tcl_DStringInit(&dirString); - - if (user == NULL || user[0] == 0) { - /* No user name specified -> current user */ - - dir = TclGetEnv("HOME", &dirString); - if (dir == NULL) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment variable to" - " expand path", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", - "HOMELESS", (void *)NULL); - } - return TCL_ERROR; - } - } else { - /* User name specified - ~user */ - dir = TclpGetUserHome(user, &dirString); - if (dir == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", user)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", - (void *)NULL); - } - return TCL_ERROR; - } - } - if (subPath) { - const char *parts[2]; - parts[0] = dir; - parts[1] = subPath; - Tcl_JoinPath(2, parts, dsPtr); - } else { - Tcl_JoinPath(1, &dir, dsPtr); - } - - Tcl_DStringFree(&dirString); - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclGetHomeDirObj -- - * - * Wrapper around MakeTildeRelativePath. See that function. - * - * Results: - * Returns a Tcl_Obj containing the home directory of a user - * or NULL on failure with error message in interp if non-NULL. - * - *---------------------------------------------------------------------- - */ -Tcl_Obj * -TclGetHomeDirObj( - Tcl_Interp *interp, /* May be NULL. Only used for error messages */ - const char *user) /* User name. NULL -> current user */ -{ - Tcl_DString dirString; - - if (MakeTildeRelativePath(interp, user, NULL, &dirString) != TCL_OK) { - return NULL; - } - return Tcl_DStringToObj(&dirString); -} - -/* - *---------------------------------------------------------------------- - * - * TclResolveTildePath -- - * - * If the passed path is begins with a tilde, does tilde resolution - * and returns a Tcl_Obj containing the resolved path. If the tilde - * component cannot be resolved, returns NULL. If the path does not - * begin with a tilde, returns as is. - * - * Results: - * Returns a Tcl_Obj with resolved path. This may be a new Tcl_Obj - * with ref count 0 or that pathObj that was passed in without its - * ref count modified. - * Returns NULL if the path begins with a ~ that cannot be resolved - * and stores an error message in interp if non-NULL. - * - *---------------------------------------------------------------------- - */ -Tcl_Obj * -TclResolveTildePath( - Tcl_Interp *interp, /* May be NULL. Only used for error messages */ - Tcl_Obj *pathObj) -{ - const char *path; - int len; - int split; - Tcl_DString resolvedPath; - - path = TclGetStringFromObj(pathObj, &len); - if (path[0] != '~') { - return pathObj; - } - - /* - * We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc. - * split becomes value 1 for '~/...' as well as for '~'. Note on - * Windows FindSplitPos will implicitly check for '\' as separator - * in addition to what is passed. - */ - split = FindSplitPos(path, '/'); - - if (split == 1) { - /* No user name specified -> current user */ - if (MakeTildeRelativePath( - interp, NULL, path[1] ? 2 + path : NULL, &resolvedPath) - != TCL_OK) { - return NULL; - } - } else { - /* User name specified - ~user */ - const char *expandedUser; - Tcl_DString userName; - - Tcl_DStringInit(&userName); - Tcl_DStringAppend(&userName, path+1, split-1); - expandedUser = Tcl_DStringValue(&userName); - - /* path[split] is / or \0 */ - if (MakeTildeRelativePath(interp, - expandedUser, - path[split] ? &path[split+1] : NULL, - &resolvedPath) - != TCL_OK) { - Tcl_DStringFree(&userName); - return NULL; - } - Tcl_DStringFree(&userName); - } - return Tcl_DStringToObj(&resolvedPath); -} - -/* - *---------------------------------------------------------------------- - * - * TclResolveTildePathList -- - * - * Given a Tcl_Obj that is a list of paths, returns a Tcl_Obj containing - * the paths with any ~-prefixed paths resolved. - * - * Empty strings and ~-prefixed paths that cannot be resolved are - * removed from the returned list. - * - * The trailing components of the path are returned verbatim. No - * processing is done on them. Moreover, no assumptions should be - * made about the separators in the returned path. They may be / - * or native. Appropriate path manipulations functions should be - * used by caller if desired. - * - * Results: - * Returns a Tcl_Obj with resolved paths. This may be a new Tcl_Obj with - * reference count 0 or the original passed-in Tcl_Obj if no paths needed - * resolution. A NULL is returned if the passed in value is not a list - * or was NULL. - * - *---------------------------------------------------------------------- - */ -Tcl_Obj * -TclResolveTildePathList( - Tcl_Obj *pathsObj) -{ - Tcl_Obj **objv; - int objc; - int i; - Tcl_Obj *resolvedPaths; - const char *path; - - if (pathsObj == NULL) { - return NULL; - } - if (Tcl_ListObjGetElements(NULL, pathsObj, &objc, &objv) != TCL_OK) { - return NULL; /* Not a list */ - } - - /* - * Figure out if any paths need resolving to avoid unnecessary allocations. - */ - for (i = 0; i < objc; ++i) { - path = Tcl_GetString(objv[i]); - if (path[0] == '~') { - break; /* At least one path needs resolution */ - } - } - if (i == objc) { - return pathsObj; /* No paths needed to be resolved */ - } - - resolvedPaths = Tcl_NewListObj(objc, NULL); - for (i = 0; i < objc; ++i) { - Tcl_Obj *resolvedPath; - path = Tcl_GetString(objv[i]); - if (path[0] == 0) { - continue; /* Skip empty strings */ - } - resolvedPath = TclResolveTildePath(NULL, objv[i]); - if (resolvedPath) { - /* Paths that cannot be resolved are skipped */ - Tcl_ListObjAppendElement(NULL, resolvedPaths, resolvedPath); - } - } - - return resolvedPaths; -} - - -/* * Local Variables: * mode: c * c-basic-offset: 4 |