diff options
Diffstat (limited to 'generic/tclPathObj.c')
| -rw-r--r-- | generic/tclPathObj.c | 502 |
1 files changed, 176 insertions, 326 deletions
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index b69607a..1f26ddf 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 (c) 2003 Vince Darley. + * Copyright © 2003 Vince Darley. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -36,7 +36,7 @@ static int MakePathFromNormalized(Tcl_Interp *interp, * internally. */ -static const Tcl_ObjType tclFsPathType = { +static const Tcl_ObjType fsPathType = { "path", /* name */ FreeFsPathInternalRep, /* freeIntRepProc */ DupFsPathInternalRep, /* dupIntRepProc */ @@ -47,46 +47,21 @@ static const Tcl_ObjType tclFsPathType = { /* * struct FsPath -- * - * 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. - * + * Internal representation of a Tcl_Obj of fsPathType */ typedef struct FsPath { - 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. */ + 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. */ int flags; /* Flags to describe interpretation - see * below. */ ClientData nativePathPtr; /* Native representation of this path, which @@ -110,9 +85,14 @@ typedef struct FsPath { * fields. */ -#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1) +#define PATHOBJ(pathPtr) ((FsPath *) (TclFetchInternalRep((pathPtr), &fsPathType)->twoPtrValue.ptr1)) #define SETPATHOBJ(pathPtr,fsPathPtr) \ - ((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr)) + do { \ + Tcl_ObjInternalRep ir; \ + ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreInternalRep((pathPtr), &fsPathType, &ir); \ + } while (0) #define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags) /* @@ -135,17 +115,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 of 1, which is - * therefore owned by the caller. It must be freed (with - * Tcl_DecrRefCount) by the caller when no longer needed. + * 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. * * Side effects: * None (beyond the memory allocation for the result). * * Special note: - * 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. + * Originally based on code from Matt Newman and Jean-Claude Wippler. + * Totally rewritten later by Vince Darley to handle symbolic links. * *--------------------------------------------------------------------------- */ @@ -232,7 +212,7 @@ TclFSNormalizeAbsolutePath( retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } - Tcl_GetStringFromObj(retVal, &curLen); + TclGetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } @@ -258,7 +238,7 @@ TclFSNormalizeAbsolutePath( retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } - Tcl_GetStringFromObj(retVal, &curLen); + TclGetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } @@ -289,7 +269,7 @@ TclFSNormalizeAbsolutePath( */ const char *path = - Tcl_GetStringFromObj(retVal, &curLen); + TclGetStringFromObj(retVal, &curLen); while (--curLen >= 0) { if (IsSeparatorOrNull(path[curLen])) { @@ -304,7 +284,7 @@ TclFSNormalizeAbsolutePath( Tcl_SetObjLength(retVal, curLen+1); Tcl_AppendObjToObj(retVal, linkObj); TclDecrRefCount(linkObj); - linkStr = Tcl_GetStringFromObj(retVal, &curLen); + linkStr = TclGetStringFromObj(retVal, &curLen); } else { /* * Absolute link. @@ -317,7 +297,7 @@ TclFSNormalizeAbsolutePath( } else { retVal = linkObj; } - linkStr = Tcl_GetStringFromObj(retVal, &curLen); + linkStr = TclGetStringFromObj(retVal, &curLen); /* * Convert to forward-slashes on windows. @@ -334,7 +314,7 @@ TclFSNormalizeAbsolutePath( } } } else { - linkStr = Tcl_GetStringFromObj(retVal, &curLen); + linkStr = TclGetStringFromObj(retVal, &curLen); } /* @@ -405,7 +385,7 @@ TclFSNormalizeAbsolutePath( if (tclPlatform == TCL_PLATFORM_WINDOWS) { int len; - const char *path = Tcl_GetStringFromObj(retVal, &len); + const char *path = TclGetStringFromObj(retVal, &len); if (len == 2 && path[0] != 0 && path[1] == ':') { if (Tcl_IsShared(retVal)) { @@ -564,7 +544,7 @@ TclPathPart( Tcl_Obj *pathPtr, /* Path to take dirname of */ Tcl_PathPart portion) /* Requested portion of name */ { - if (pathPtr->typePtr == &tclFsPathType) { + if (TclHasInternalRep(pathPtr, &fsPathType)) { FsPath *fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0) { @@ -580,7 +560,7 @@ TclPathPart( int numBytes; const char *rest = - Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); + TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; @@ -618,7 +598,7 @@ TclPathPart( int numBytes; const char *rest = - Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); + TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; @@ -647,7 +627,7 @@ TclPathPart( const char *fileName, *extension; int length; - fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, + fileName = TclGetStringFromObj(fsPathPtr->normPathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { @@ -699,7 +679,7 @@ TclPathPart( int length; const char *fileName, *extension; - fileName = Tcl_GetStringFromObj(pathPtr, &length); + fileName = TclGetStringFromObj(pathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { Tcl_IncrRefCount(pathPtr); @@ -714,9 +694,8 @@ TclPathPart( } /* - * The behaviour we want here is slightly different to the standard * Tcl_FSSplitPath in the handling of home directories; - * Tcl_FSSplitPath preserves the "~" while this code computes the + * Tcl_FSSplitPath preserves the "~", but this code computes the * actual full path name, if we had just a single component. */ @@ -865,6 +844,7 @@ TclJoinPath( if (elements == 2) { Tcl_Obj *elt = objv[0]; + Tcl_ObjInternalRep *eltIr = TclFetchInternalRep(elt, &fsPathType); /* * This is a special case where we can be much more efficient, where @@ -875,10 +855,10 @@ TclJoinPath( * could expand that in the future. * * Bugfix [a47641a0]. TclNewFSPathObj requires first argument - * to be an absolute path. Added a check for that elt is absolute. + * to be an absolute path. Added a check to ensure that elt is absolute. */ - if ((elt->typePtr == &tclFsPathType) + if ((eltIr) && !((elt->bytes != NULL) && (elt->bytes[0] == '\0')) && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) { Tcl_Obj *tailObj = objv[1]; @@ -891,7 +871,7 @@ TclJoinPath( const char *str; int len; - str = Tcl_GetStringFromObj(tailObj, &len); + str = TclGetStringFromObj(tailObj, &len); if (len == 0) { /* * This happens if we try to handle the root volume '/'. @@ -962,7 +942,7 @@ TclJoinPath( Tcl_Obj *driveName = NULL; Tcl_Obj *elt = objv[i]; - strElt = Tcl_GetStringFromObj(elt, &strEltLen); + strElt = TclGetStringFromObj(elt, &strEltLen); driveNameLength = 0; /* if forceRelative - all paths excepting first one are relative */ type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE : @@ -1058,10 +1038,8 @@ TclJoinPath( noQuickReturn: if (res == NULL) { TclNewObj(res); - 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 @@ -1094,7 +1072,7 @@ TclJoinPath( if (sep != NULL) { separator = TclGetString(sep)[0]; - Tcl_DecrRefCount(sep); + TclDecrRefCount(sep); } /* Safety check in case the VFS driver caused sharing */ if (Tcl_IsShared(res)) { @@ -1106,7 +1084,7 @@ TclJoinPath( if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); - Tcl_GetStringFromObj(res, &length); + TclGetStringFromObj(res, &length); } Tcl_SetObjLength(res, length + (int) strlen(strElt)); @@ -1172,39 +1150,16 @@ Tcl_FSConvertToPathType( * path. */ - if (pathPtr->typePtr == &tclFsPathType) { + if (TclHasInternalRep(pathPtr, &fsPathType)) { if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) { return TCL_OK; } - if (pathPtr->bytes == NULL) { - UpdateStringOfFsPath(pathPtr); - } - FreeFsPathInternalRep(pathPtr); + TclGetString(pathPtr); + Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL); } 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. - */ } /* @@ -1319,7 +1274,7 @@ TclNewFSPathObj( } TclNewObj(pathPtr); - fsPathPtr = ckalloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); /* * Set up the path. @@ -1336,9 +1291,7 @@ TclNewFSPathObj( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = TCLPATH_APPENDED; - pathPtr->typePtr = &tclFsPathType; - pathPtr->bytes = NULL; - pathPtr->length = 0; + TclInvalidateStringRep(pathPtr); /* * Look for path components made up of only "." @@ -1400,7 +1353,7 @@ AppendPath( * internalrep 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); + bytes = TclGetStringFromObj(tail, &numBytes); if (numBytes == 0) { Tcl_AppendToObj(copy, "/", 1); } else { @@ -1433,14 +1386,15 @@ AppendPath( Tcl_Obj * TclFSMakePathRelative( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + TCL_UNUSED(Tcl_Interp *), 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 (pathPtr->typePtr == &tclFsPathType) { + if (irPtr) { FsPath *fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { @@ -1459,7 +1413,7 @@ TclFSMakePathRelative( * too little below, leading to wrong answers returned by glob. */ - tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen); + tempStr = TclGetStringFromObj(cwdPtr, &cwdLen); /* * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the @@ -1479,7 +1433,7 @@ TclFSMakePathRelative( } break; } - tempStr = Tcl_GetStringFromObj(pathPtr, &len); + tempStr = TclGetStringFromObj(pathPtr, &len); return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen); } @@ -1503,36 +1457,16 @@ TclFSMakePathRelative( static int MakePathFromNormalized( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; - if (pathPtr->typePtr == &tclFsPathType) { + if (TclHasInternalRep(pathPtr, &fsPathType)) { return TCL_OK; } - /* - * Free old representation - */ - - if (pathPtr->typePtr != NULL) { - if (pathPtr->bytes == NULL) { - if (pathPtr->typePtr->updateStringProc == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't find object string representation", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF", - NULL); - } - return TCL_ERROR; - } - pathPtr->typePtr->updateStringProc(pathPtr); - } - TclFreeIntRep(pathPtr); - } - - fsPathPtr = ckalloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); /* * It's a pure normalized absolute path. @@ -1540,11 +1474,7 @@ MakePathFromNormalized( fsPathPtr->translatedPathPtr = NULL; - /* - * Circular reference by design. - */ - - fsPathPtr->normPathPtr = pathPtr; + Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr)); fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; @@ -1553,7 +1483,6 @@ MakePathFromNormalized( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; - pathPtr->typePtr = &tclFsPathType; return TCL_OK; } @@ -1563,7 +1492,7 @@ MakePathFromNormalized( * * Tcl_FSNewNativePath -- * - * This function performs the something like the reverse of the usual + * 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 @@ -1604,25 +1533,12 @@ Tcl_FSNewNativePath( * safe. */ - if (pathPtr->typePtr != NULL) { - if (pathPtr->bytes == NULL) { - if (pathPtr->typePtr->updateStringProc == NULL) { - return NULL; - } - pathPtr->typePtr->updateStringProc(pathPtr); - } - TclFreeIntRep(pathPtr); - } - - fsPathPtr = ckalloc(sizeof(FsPath)); + Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL); + fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; - /* - * Circular reference, by design. - */ - - fsPathPtr->normPathPtr = pathPtr; + Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr)); fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; fsPathPtr->fsPtr = fromFilesystem; @@ -1630,7 +1546,6 @@ Tcl_FSNewNativePath( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; - pathPtr->typePtr = &tclFsPathType; return pathPtr; } @@ -1640,16 +1555,18 @@ Tcl_FSNewNativePath( * * Tcl_FSGetTranslatedPath -- * - * This function attempts to extract the translated path from the given + * 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 will be returned, and an - * error message may be left in the interpreter (if it is non-NULL) + * path), then it is returned. Otherwise NULL is returned and an + * error message may be left in the interpreter if it is not NULL. * * Results: - * NULL or a valid Tcl_Obj pointer. + * A Tcl_Obj pointer or NULL. * * Side effects: - * Only those of 'Tcl_FSConvertToPathType' + * pathPtr is converted to fsPathType if necessary. + * + * FsPath members are modified as needed. * *--------------------------------------------------------------------------- */ @@ -1667,7 +1584,12 @@ Tcl_FSGetTranslatedPath( } srcFsPathPtr = PATHOBJ(pathPtr); if (srcFsPathPtr->translatedPathPtr == NULL) { - if (PATHFLAGS(pathPtr) != 0) { + if (PATHFLAGS(pathPtr) == 0) { + /* + * Path is already normalized + */ + retObj = srcFsPathPtr->normPathPtr; + } else { /* * We lack a translated path result, but we have a directory * (cwdPtr) and a tail (normPathPtr), and if we join the @@ -1677,29 +1599,23 @@ 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); - srcFsPathPtr->translatedPathPtr = retObj; - if (translatedCwdPtr->typePtr == &tclFsPathType) { + Tcl_IncrRefCount(srcFsPathPtr->translatedPathPtr = retObj); + translatedCwdIrPtr = TclFetchInternalRep(translatedCwdPtr, &fsPathType); + if (translatedCwdIrPtr) { 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 { /* @@ -1743,8 +1659,8 @@ Tcl_FSGetTranslatedStringPath( if (transPtr != NULL) { int len; - const char *orig = Tcl_GetStringFromObj(transPtr, &len); - char *result = ckalloc(len+1); + const char *orig = TclGetStringFromObj(transPtr, &len); + char *result = (char *)ckalloc(len+1); memcpy(result, orig, len+1); TclDecrRefCount(transPtr); @@ -1800,11 +1716,9 @@ Tcl_FSGetNormalizedPath( return NULL; } /* TODO: Figure out why this is needed. */ - if (pathPtr->bytes == NULL) { - UpdateStringOfFsPath(pathPtr); - } + TclGetString(pathPtr); - Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen); + TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen); if (tailLen) { copy = AppendPath(dir, fsPathPtr->normPathPtr); } else { @@ -1817,7 +1731,7 @@ Tcl_FSGetNormalizedPath( * We now own a reference on both 'dir' and 'copy' */ - (void) Tcl_GetStringFromObj(dir, &cwdLen); + (void) TclGetStringFromObj(dir, &cwdLen); /* Normalize the combined string. */ @@ -1854,7 +1768,7 @@ Tcl_FSGetNormalizedPath( /* * NOTE: here we are (dangerously?) assuming that origDir points - * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType. The + * to a Tcl_Obj with Tcl_ObjType == &fsPathType. 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 @@ -1869,10 +1783,6 @@ Tcl_FSGetNormalizedPath( TclDecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; - /* - * That's our reference to copy used. - */ - TclDecrRefCount(dir); TclDecrRefCount(origDir); } else { @@ -1881,10 +1791,6 @@ Tcl_FSGetNormalizedPath( TclDecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; - /* - * That's our reference to copy used. - */ - TclDecrRefCount(dir); } PATHFLAGS(pathPtr) = 0; @@ -1896,10 +1802,8 @@ Tcl_FSGetNormalizedPath( if (fsPathPtr->cwdPtr != NULL) { if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { - if (pathPtr->bytes == NULL) { - UpdateStringOfFsPath(pathPtr); - } - FreeFsPathInternalRep(pathPtr); + TclGetString(pathPtr); + Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL); if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) { return NULL; } @@ -1910,7 +1814,7 @@ Tcl_FSGetNormalizedPath( copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); - (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); + (void) TclGetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); cwdLen += (Tcl_GetString(copy)[cwdLen] == '/'); /* @@ -1925,10 +1829,9 @@ 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. */ @@ -1975,7 +1878,6 @@ Tcl_FSGetNormalizedPath( return NULL; } - pureNormalized = 0; Tcl_DecrRefCount(absolutePath); absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); Tcl_IncrRefCount(absolutePath); @@ -1995,7 +1897,6 @@ Tcl_FSGetNormalizedPath( if (absolutePath == NULL) { return NULL; } - pureNormalized = 0; #endif /* _WIN32 */ } } @@ -2004,35 +1905,12 @@ 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) { - 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. - */ - - 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 @@ -2053,19 +1931,23 @@ Tcl_FSGetNormalizedPath( * * Tcl_FSGetInternalRep -- * - * 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. + * Produces a native representation of a given path object in the given + * filesystem. * - * If the internal representation is currently NULL, we attempt to - * generate it, by calling the filesystem's - * 'Tcl_FSCreateInternalRepProc'. + * 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. * * Results: - * NULL or a valid internal representation. + * + * The native handle for the path, or NULL if the path is not handled by + * the given filesystem * * Side effects: - * An attempt may be made to convert the object. + * + * Tcl_FSCreateInternalRepProc if needed to produce the native + * handle, which is then stored in the internal representation of pathPtr. * *--------------------------------------------------------------------------- */ @@ -2083,49 +1965,36 @@ Tcl_FSGetInternalRep( srcFsPathPtr = PATHOBJ(pathPtr); /* - * 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. + * 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. * * 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 easily achievable with the current implementation. + * not currently easily achievable. */ 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; } } /* - * 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 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. */ if (fsPtr != srcFsPathPtr->fsPtr) { @@ -2146,7 +2015,7 @@ Tcl_FSGetInternalRep( return NULL; } - nativePathPtr = proc(pathPtr); + nativePathPtr = (char *)proc(pathPtr); srcFsPathPtr = PATHOBJ(pathPtr); srcFsPathPtr->nativePathPtr = nativePathPtr; srcFsPathPtr->filesystemEpoch = TclFSEpoch(); @@ -2160,15 +2029,15 @@ Tcl_FSGetInternalRep( * * TclFSEnsureEpochOk -- * - * 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. + * Ensure that the path is a valid path, and that it has a + * fsPathType internal representation that is not stale. * * Results: - * Standard Tcl return code. + * A standard Tcl return code. * * Side effects: - * An attempt may be made to convert the object. + * The internal representation of fsPtrPtr is converted to fsPathType if + * possible. * *--------------------------------------------------------------------------- */ @@ -2180,37 +2049,31 @@ TclFSEnsureEpochOk( { FsPath *srcFsPathPtr; - if (pathPtr->typePtr != &tclFsPathType) { + if (!TclHasInternalRep(pathPtr, &fsPathType)) { 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)) { /* - * We have to discard the stale representation and recalculate it. + * The filesystem has changed in some way since the internal + * representation for this object was calculated. Discard the stale + * representation and recalculate it. */ - if (pathPtr->bytes == NULL) { - UpdateStringOfFsPath(pathPtr); - } - FreeFsPathInternalRep(pathPtr); + TclGetString(pathPtr); + Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL); 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; @@ -2244,7 +2107,7 @@ TclFSSetPathDetails( * Make sure pathPtr is of the correct type. */ - if (pathPtr->typePtr != &tclFsPathType) { + if (!TclHasInternalRep(pathPtr, &fsPathType)) { if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return; } @@ -2318,11 +2181,12 @@ Tcl_FSEqualPaths( * * SetFsPathFromAny -- * - * This function tries to convert the given Tcl_Obj to a valid Tcl path - * type. + * Attempt to convert the internal representation of pathPtr to + * fsPathType. * - * The filename may begin with "~" (to indicate current user's home - * directory) or "~<user>" (to indicate any user's home directory). + * A tilde ("~") character at the beginnig of the filename indicates the + * current user's home directory, and "~<user>" indicates a particular + * user's directory. * * Results: * Standard Tcl error code. @@ -2341,9 +2205,9 @@ SetFsPathFromAny( int len; FsPath *fsPathPtr; Tcl_Obj *transPtr; - char *name; + const char *name; - if (pathPtr->typePtr == &tclFsPathType) { + if (TclHasInternalRep(pathPtr, &fsPathType)) { return TCL_OK; } @@ -2361,7 +2225,7 @@ SetFsPathFromAny( * cmdAH.test exercise most of the code). */ - name = Tcl_GetStringFromObj(pathPtr, &len); + name = TclGetStringFromObj(pathPtr, &len); /* * Handle tilde substitutions, if needed. @@ -2406,7 +2270,7 @@ SetFsPathFromAny( Tcl_DStringFree(&dirString); } else { /* - * We have a user name '~user' + * There is a '~user' */ const char *expandedUser; @@ -2483,29 +2347,23 @@ SetFsPathFromAny( * slashes on Windows, and will not contain any ~user sequences. */ - fsPathPtr = ckalloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); - fsPathPtr->translatedPathPtr = transPtr; - if (transPtr != pathPtr) { - Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); - /* Redo translation when $env(HOME) changes */ - fsPathPtr->filesystemEpoch = TclFSEpoch(); + if (transPtr == pathPtr) { + transPtr = Tcl_DuplicateObj(pathPtr); + fsPathPtr->filesystemEpoch = 0; } else { - fsPathPtr->filesystemEpoch = 0; + fsPathPtr->filesystemEpoch = TclFSEpoch(); } + 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; } @@ -2528,6 +2386,7 @@ FreeFsPathInternalRep( } if (fsPathPtr->cwdPtr != NULL) { TclDecrRefCount(fsPathPtr->cwdPtr); + fsPathPtr->cwdPtr = NULL; } if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) { Tcl_FSFreeInternalRepProc *freeProc = @@ -2540,7 +2399,6 @@ FreeFsPathInternalRep( } ckfree(fsPathPtr); - pathPtr->typePtr = NULL; } static void @@ -2549,28 +2407,18 @@ DupFsPathInternalRep( Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */ { FsPath *srcFsPathPtr = PATHOBJ(srcPtr); - FsPath *copyFsPathPtr = ckalloc(sizeof(FsPath)); + FsPath *copyFsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); SETPATHOBJ(copyPtr, copyFsPathPtr); - 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->translatedPathPtr = srcFsPathPtr->translatedPathPtr; + if (copyFsPathPtr->translatedPathPtr != NULL) { + Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr); } - 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->normPathPtr = srcFsPathPtr->normPathPtr; + if (copyFsPathPtr->normPathPtr != NULL) { + Tcl_IncrRefCount(copyFsPathPtr->normPathPtr); } copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr; @@ -2596,8 +2444,6 @@ DupFsPathInternalRep( } copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; - - copyPtr->typePtr = &tclFsPathType; } /* @@ -2629,11 +2475,15 @@ UpdateStringOfFsPath( } copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr); + if (Tcl_IsShared(copy)) { + copy = Tcl_DuplicateObj(copy); + } - pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); + Tcl_IncrRefCount(copy); + /* Steal copy's string rep */ + pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen); pathPtr->length = cwdLen; - copy->bytes = tclEmptyStringRep; - copy->length = 0; + TclInitStringRep(copy, NULL, 0); TclDecrRefCount(copy); } @@ -2661,7 +2511,7 @@ UpdateStringOfFsPath( int TclNativePathInFilesystem( Tcl_Obj *pathPtr, - ClientData *clientDataPtr) + TCL_UNUSED(ClientData *)) { /* * A special case is required to handle the empty path "". This is a valid @@ -2670,7 +2520,7 @@ TclNativePathInFilesystem( * semantics of Tcl (at present anyway), so we have to abide by them here. */ - if (pathPtr->typePtr == &tclFsPathType) { + if (TclHasInternalRep(pathPtr, &fsPathType)) { if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') { /* * We reject the empty path "". @@ -2685,13 +2535,13 @@ TclNativePathInFilesystem( } else { /* * It is somewhat unusual to reach this code path without the object - * being of tclFsPathType. However, we do our best to deal with the + * being of fsPathType. However, we do our best to deal with the * situation. */ int len; - (void) Tcl_GetStringFromObj(pathPtr, &len); + (void) TclGetStringFromObj(pathPtr, &len); if (len == 0) { /* * We reject the empty path "". |