diff options
Diffstat (limited to 'generic/tclPathObj.c')
| -rw-r--r-- | generic/tclPathObj.c | 1319 |
1 files changed, 685 insertions, 634 deletions
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 362d489..fe6063f 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -9,8 +9,6 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclPathObj.c,v 1.42 2005/07/21 14:38:50 dkf Exp $ */ #include "tclInt.h" @@ -20,22 +18,24 @@ * Prototypes for functions defined later in this file. */ -static void DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, - Tcl_Obj *copyPtr)); -static void FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *pathPtr)); -static void UpdateStringOfFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr)); -static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *pathPtr)); -static int FindSplitPos _ANSI_ARGS_((CONST char *path, int separator)); -static int IsSeparatorOrNull _ANSI_ARGS_((int ch)); -static Tcl_Obj* GetExtension _ANSI_ARGS_((Tcl_Obj *pathPtr)); +static Tcl_Obj * AppendPath(Tcl_Obj *head, Tcl_Obj *tail); +static void DupFsPathInternalRep(Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr); +static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); +static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); +static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); +static int FindSplitPos(const char *path, int separator); +static int IsSeparatorOrNull(int ch); +static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); +static int MakePathFromNormalized(Tcl_Interp *interp, + Tcl_Obj *pathPtr); /* * Define the 'path' object type, which Tcl uses to represent file paths * internally. */ -Tcl_ObjType tclFsPathType = { +static const Tcl_ObjType tclFsPathType = { "path", /* name */ FreeFsPathInternalRep, /* freeIntRepProc */ DupFsPathInternalRep, /* dupIntRepProc */ @@ -46,7 +46,7 @@ Tcl_ObjType tclFsPathType = { /* * struct FsPath -- * - * Internal representation of a Tcl_Obj of "path" type. This can be used to + * 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. * @@ -58,8 +58,8 @@ Tcl_ObjType tclFsPathType = { * (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 + * 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). @@ -72,7 +72,7 @@ Tcl_ObjType tclFsPathType = { */ typedef struct FsPath { - Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this + 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 @@ -84,19 +84,17 @@ typedef struct FsPath { * 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 + * 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 + ClientData nativePathPtr; /* Native representation of this path, which * is filesystem dependent. */ int filesystemEpoch; /* Used to ensure the path representation was * generated during the correct filesystem * epoch. The epoch changes when * filesystem-mounts are changed. */ - struct FilesystemRecord *fsRecPtr; - /* Pointer to the filesystem record entry to - * use for this path. */ + const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */ } FsPath; /* @@ -104,16 +102,17 @@ typedef struct FsPath { */ #define TCLPATH_APPENDED 1 +#define TCLPATH_NEEDNORM 4 /* * Define some macros to give us convenient access to path-object specific * fields. */ -#define PATHOBJ(pathPtr) (pathPtr->internalRep.otherValuePtr) -#define PATHFLAGS(pathPtr) \ - (((FsPath*)(pathPtr->internalRep.otherValuePtr))->flags) - +#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1) +#define SETPATHOBJ(pathPtr,fsPathPtr) \ + ((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr)) +#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags) /* *--------------------------------------------------------------------------- @@ -123,8 +122,8 @@ typedef struct FsPath { * Takes an absolute path specification and computes a 'normalized' path * from it. * - * A normalized path is one which has all '../', './' removed. Also it - * is one which is in the 'standard' format for the native platform. On + * A normalized path is one which has all '../', './' removed. Also it is + * one which is in the 'standard' format for the native platform. On * Unix, this means the path must be free of symbolic links/aliases, and * on Windows it means we want the long form, with that long form's * case-dependence (which gives us a unique, case-dependent path). @@ -150,18 +149,12 @@ typedef struct FsPath { *--------------------------------------------------------------------------- */ -Tcl_Obj* -TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) - Tcl_Interp* interp; /* Interpreter to use */ - Tcl_Obj *pathPtr; /* Absolute path to normalize */ - ClientData *clientDataPtr; /* If non-NULL, then may be set to the - * fs-specific clientData for this path. This - * will happen when that extra information can - * be calculated efficiently as a side-effect - * of normalization. */ +Tcl_Obj * +TclFSNormalizeAbsolutePath( + Tcl_Interp *interp, /* Interpreter to use */ + Tcl_Obj *pathPtr) /* Absolute path to normalize */ { - ClientData clientData = NULL; - CONST char *dirSep, *oldDirSep; + const char *dirSep, *oldDirSep; int first = 1; /* Set to zero once we've passed the first * directory separator - we can't use '..' to * remove the volume in a path. */ @@ -169,6 +162,21 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) dirSep = TclGetString(pathPtr); if (tclPlatform == TCL_PLATFORM_WINDOWS) { + if ( (dirSep[0] == '/' || dirSep[0] == '\\') + && (dirSep[1] == '/' || dirSep[1] == '\\') + && (dirSep[2] == '?') + && (dirSep[3] == '/' || dirSep[3] == '\\')) { + /* NT extended path */ + dirSep += 4; + + if ( (dirSep[0] == 'U' || dirSep[0] == 'u') + && (dirSep[1] == 'N' || dirSep[1] == 'n') + && (dirSep[2] == 'C' || dirSep[2] == 'c') + && (dirSep[3] == '/' || dirSep[3] == '\\')) { + /* NT extended UNC path */ + dirSep += 4; + } + } if (dirSep[0] != 0 && dirSep[1] == ':' && (dirSep[2] == '/' || dirSep[2] == '\\')) { /* Do nothing */ @@ -189,7 +197,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) /* * Scan forward from one directory separator to the next, checking for - * '..' and '.' sequences which must be handled specially. In particular + * '..' and '.' sequences which must be handled specially. In particular * handling of '..' can be complicated if the directory before is a link, * since we will have to expand the link to be able to back up one level. */ @@ -216,12 +224,17 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) /* * Need to skip '.' in the path. */ + int curLen; if (retVal == NULL) { - CONST char *path = TclGetString(pathPtr); + const char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } + Tcl_GetStringFromObj(retVal, &curLen); + if (curLen == 0) { + Tcl_AppendToObj(retVal, dirSep, 1); + } dirSep += 2; oldDirSep = dirSep; if (dirSep[0] != 0 && dirSep[1] == '.') { @@ -230,7 +243,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) continue; } if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) { - Tcl_Obj *link; + Tcl_Obj *linkObj; int curLen; char *linkStr; @@ -239,28 +252,42 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) */ if (retVal == NULL) { - CONST char *path = TclGetString(pathPtr); + const char *path = TclGetString(pathPtr); + retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } + Tcl_GetStringFromObj(retVal, &curLen); + if (curLen == 0) { + Tcl_AppendToObj(retVal, dirSep, 1); + } if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) { - link = Tcl_FSLink(retVal, NULL, 0); - if (link != NULL) { + linkObj = Tcl_FSLink(retVal, NULL, 0); + + /* Safety check in case driver caused sharing */ + if (Tcl_IsShared(retVal)) { + TclDecrRefCount(retVal); + retVal = Tcl_DuplicateObj(retVal); + Tcl_IncrRefCount(retVal); + } + + if (linkObj != NULL) { /* * Got a link. Need to check if the link is relative * or absolute, for those platforms where relative * links exist. */ - if (tclPlatform != TCL_PLATFORM_WINDOWS && - Tcl_FSGetPathType(link) == TCL_PATH_RELATIVE) { + if (tclPlatform != TCL_PLATFORM_WINDOWS + && Tcl_FSGetPathType(linkObj) + == TCL_PATH_RELATIVE) { /* * We need to follow this link which is relative * to retVal's directory. This means concatenating * the link onto the directory of the path so far. */ - CONST char *path = + const char *path = Tcl_GetStringFromObj(retVal, &curLen); while (--curLen >= 0) { @@ -268,19 +295,14 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) break; } } - if (Tcl_IsShared(retVal)) { - TclDecrRefCount(retVal); - retVal = Tcl_DuplicateObj(retVal); - Tcl_IncrRefCount(retVal); - } /* * We want the trailing slash. */ Tcl_SetObjLength(retVal, curLen+1); - Tcl_AppendObjToObj(retVal, link); - TclDecrRefCount(link); + Tcl_AppendObjToObj(retVal, linkObj); + TclDecrRefCount(linkObj); linkStr = Tcl_GetStringFromObj(retVal, &curLen); } else { /* @@ -288,7 +310,12 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) */ TclDecrRefCount(retVal); - retVal = link; + if (Tcl_IsShared(linkObj)) { + retVal = Tcl_DuplicateObj(linkObj); + TclDecrRefCount(linkObj); + } else { + retVal = linkObj; + } linkStr = Tcl_GetStringFromObj(retVal, &curLen); /* @@ -297,6 +324,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) if (tclPlatform == TCL_PLATFORM_WINDOWS) { int i; + for (i = 0; i < curLen; i++) { if (linkStr[i] == '\\') { linkStr[i] = '/'; @@ -309,18 +337,28 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) } /* - * Either way, we now remove the last path element. + * Either way, we now remove the last path element (but + * not the first character of the path). */ while (--curLen >= 0) { if (IsSeparatorOrNull(linkStr[curLen])) { - Tcl_SetObjLength(retVal, curLen); + if (curLen) { + Tcl_SetObjLength(retVal, curLen); + } else { + Tcl_SetObjLength(retVal, 1); + } break; } } } dirSep += 3; oldDirSep = dirSep; + + if ((curLen == 0) && (dirSep[0] != 0)) { + Tcl_SetObjLength(retVal, 0); + } + if (dirSep[0] != 0 && dirSep[1] == '.') { goto again; } @@ -345,9 +383,9 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) /* * Unfortunately, the platform-specific normalization code which * will be called below has no way of dealing with the case where - * an object is shared. It is expecting to modify an object in - * place. So, we must duplicate this here to ensure an object - * with a single ref-count. + * an object is shared. It is expecting to modify an object in + * place. So, we must duplicate this here to ensure an object with + * a single ref-count. * * If that changes in the future (e.g. the normalize proc is given * one object and is able to return a different one), then we @@ -361,12 +399,12 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) } /* - * Ensure a windows drive like C:/ has a trailing separator + * Ensure a windows drive like C:/ has a trailing separator. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { int len; - CONST char *path = Tcl_GetStringFromObj(retVal, &len); + const char *path = Tcl_GetStringFromObj(retVal, &len); if (len == 2 && path[0] != 0 && path[1] == ':') { if (Tcl_IsShared(retVal)) { @@ -380,7 +418,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) /* * Now we have an absolute path, with no '..', '.' sequences, but it still - * may not be in 'unique' form, depending on the platform. For instance, + * may not be in 'unique' form, depending on the platform. For instance, * Unix is case-sensitive, so the path is ok. Windows is case-insensitive, * and also has the weird 'longname/shortname' thing (e.g. C:/Program * Files/ and C:/Progra~1/ are equivalent). @@ -389,17 +427,14 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) * for normalizing a path. */ - TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData); + TclFSNormalizeToUniquePath(interp, retVal, 0); /* * Since we know it is a normalized path, we can actually convert this * object into an FsPath for greater efficiency */ - TclFSMakePathFromNormalized(interp, retVal, clientData); - if (clientDataPtr != NULL) { - *clientDataPtr = clientData; - } + MakePathFromNormalized(interp, retVal); /* * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs. @@ -427,8 +462,8 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) */ Tcl_PathType -Tcl_FSGetPathType(pathPtr) - Tcl_Obj *pathPtr; +Tcl_FSGetPathType( + Tcl_Obj *pathPtr) { return TclFSGetPathType(pathPtr, NULL, NULL); } @@ -457,28 +492,38 @@ Tcl_FSGetPathType(pathPtr) */ Tcl_PathType -TclFSGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr) - Tcl_Obj *pathPtr; - Tcl_Filesystem **filesystemPtrPtr; - int *driveNameLengthPtr; +TclFSGetPathType( + Tcl_Obj *pathPtr, + const Tcl_Filesystem **filesystemPtrPtr, + int *driveNameLengthPtr) { + FsPath *fsPathPtr; + if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { - return TclGetPathType(pathPtr, filesystemPtrPtr, - driveNameLengthPtr, NULL); - } else { - FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, + NULL); + } - if (fsPathPtr->cwdPtr != NULL) { - if (PATHFLAGS(pathPtr) == 0) { - return TCL_PATH_RELATIVE; - } - return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, - driveNameLengthPtr); - } else { - return TclGetPathType(pathPtr, filesystemPtrPtr, - driveNameLengthPtr, NULL); - } + fsPathPtr = PATHOBJ(pathPtr); + if (fsPathPtr->cwdPtr == NULL) { + return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, + NULL); } + + if (PATHFLAGS(pathPtr) == 0) { + /* The path is not absolute... */ +#ifdef _WIN32 + /* ... on Windows we must make another call to determine whether + * it's relative or volumerelative [Bug 2571597]. */ + return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, + NULL); +#else + /* On other systems, quickly deduce !absolute -> relative */ + return TCL_PATH_RELATIVE; +#endif + } + return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, + driveNameLengthPtr); } /* @@ -494,7 +539,7 @@ TclFSGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr) * - the extension ('file extension') * - the root ('file root') * - * The 'portion' parameter dictates which of these to calculate. There + * The 'portion' parameter dictates which of these to calculate. There * are a number of special cases both to be more efficient, and because * the behaviour when given a path with only a single element is defined * to require the expansion of that single element, where possible. @@ -512,16 +557,16 @@ TclFSGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr) *--------------------------------------------------------------------------- */ -Tcl_Obj* -TclPathPart(interp, pathPtr, portion) - Tcl_Interp *interp; /* Used for error reporting */ - Tcl_Obj *pathPtr; /* Path to take dirname of */ - Tcl_PathPart portion; /* Requested portion of name */ +Tcl_Obj * +TclPathPart( + Tcl_Interp *interp, /* Used for error reporting */ + Tcl_Obj *pathPtr, /* Path to take dirname of */ + Tcl_PathPart portion) /* Requested portion of name */ { if (pathPtr->typePtr == &tclFsPathType) { - FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); - if (TclFSEpochOk(fsPathPtr->filesystemEpoch) - && (PATHFLAGS(pathPtr) != 0)) { + FsPath *fsPathPtr = PATHOBJ(pathPtr); + + if (PATHFLAGS(pathPtr) != 0) { switch (portion) { case TCL_PATH_DIRNAME: { /* @@ -532,11 +577,24 @@ TclPathPart(interp, pathPtr, portion) * the standardPath code. */ - CONST char *rest = TclGetString(fsPathPtr->normPathPtr); + int numBytes; + const char *rest = + Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; } + /* + * If the joined-on bit is empty, then [file dirname] is + * documented to return all but the last non-empty element + * of the path, so we need to split apart the main part to + * get the right answer. We could do that here, but it's + * simpler to fall back to the standardPath code. + * [Bug 2710920] + */ + if (numBytes == 0) { + goto standardPath; + } if (tclPlatform == TCL_PLATFORM_WINDOWS && strchr(rest, '\\') != NULL) { goto standardPath; @@ -557,11 +615,24 @@ TclPathPart(interp, pathPtr, portion) * we don't, and instead just use the standardPath code. */ - CONST char *rest = TclGetString(fsPathPtr->normPathPtr); + int numBytes; + const char *rest = + Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; } + /* + * If the joined-on bit is empty, then [file tail] is + * documented to return the last non-empty element + * of the path, so we need to split off the last element + * of the main part to get the right answer. We could do + * that here, but it's simpler to fall back to the + * standardPath code. [Bug 2710920] + */ + if (numBytes == 0) { + goto standardPath; + } if (tclPlatform == TCL_PLATFORM_WINDOWS && strchr(rest, '\\') != NULL) { goto standardPath; @@ -572,8 +643,7 @@ TclPathPart(interp, pathPtr, portion) case TCL_PATH_EXTENSION: return GetExtension(fsPathPtr->normPathPtr); case TCL_PATH_ROOT: { - /* Unimplemented */ - CONST char *fileName, *extension; + const char *fileName, *extension; int length; fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, @@ -589,25 +659,18 @@ TclPathPart(interp, pathPtr, portion) return pathPtr; } else { /* - * Duplicate the object we were given and then trim off - * the extension of the tail component of the path. + * Need to return the whole path with the extension + * suffix removed. Do that by joining our "head" to + * our "tail" with the extension suffix removed from + * the tail. */ - FsPath *fsDupPtr; - Tcl_Obj *root = Tcl_DuplicateObj(pathPtr); + Tcl_Obj *resultPtr = + TclNewFSPathObj(fsPathPtr->cwdPtr, fileName, + (int)(length - strlen(extension))); - Tcl_IncrRefCount(root); - fsDupPtr = (FsPath*) PATHOBJ(root); - if (Tcl_IsShared(fsDupPtr->normPathPtr)) { - TclDecrRefCount(fsDupPtr->normPathPtr); - fsDupPtr->normPathPtr = Tcl_NewStringObj(fileName, - (int)(length - strlen(extension))); - Tcl_IncrRefCount(fsDupPtr->normPathPtr); - } else { - Tcl_SetObjLength(fsDupPtr->normPathPtr, - (int)(length - strlen(extension))); - } - return root; + Tcl_IncrRefCount(resultPtr); + return resultPtr; } } default: @@ -625,8 +688,7 @@ TclPathPart(interp, pathPtr, portion) } } else { int splitElements; - Tcl_Obj *splitPtr; - Tcl_Obj *resultPtr; + Tcl_Obj *splitPtr, *resultPtr; standardPath: resultPtr = NULL; @@ -634,7 +696,7 @@ TclPathPart(interp, pathPtr, portion) return GetExtension(pathPtr); } else if (portion == TCL_PATH_ROOT) { int length; - CONST char *fileName, *extension; + const char *fileName, *extension; fileName = Tcl_GetStringFromObj(pathPtr, &length); extension = TclGetExtension(fileName); @@ -644,6 +706,7 @@ TclPathPart(interp, pathPtr, portion) } else { Tcl_Obj *root = Tcl_NewStringObj(fileName, (int) (length - strlen(extension))); + Tcl_IncrRefCount(root); return root; } @@ -692,7 +755,7 @@ TclPathPart(interp, pathPtr, portion) resultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1); } else if (splitElements == 0 || (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) { - resultPtr = Tcl_NewStringObj(".", 1); + TclNewLiteralStringObj(resultPtr, "."); } else { Tcl_ListObjIndex(NULL, splitPtr, 0, &resultPtr); } @@ -707,11 +770,11 @@ TclPathPart(interp, pathPtr, portion) * Simple helper function */ -static Tcl_Obj* -GetExtension(pathPtr) - Tcl_Obj *pathPtr; +static Tcl_Obj * +GetExtension( + Tcl_Obj *pathPtr) { - CONST char *tail, *extension; + const char *tail, *extension; Tcl_Obj *ret; tail = TclGetString(pathPtr); @@ -759,54 +822,45 @@ GetExtension(pathPtr) *--------------------------------------------------------------------------- */ -Tcl_Obj* -Tcl_FSJoinPath(listObj, elements) - Tcl_Obj *listObj; /* Path elements to join, may have a zero +Tcl_Obj * +Tcl_FSJoinPath( + Tcl_Obj *listObj, /* Path elements to join, may have a zero * reference count. */ - int elements; /* Number of elements to use (-1 = all) */ + int elements) /* Number of elements to use (-1 = all) */ { - Tcl_Obj *res; - int i; - Tcl_Filesystem *fsPtr = NULL; + Tcl_Obj *copy, *res; + int objc; + Tcl_Obj **objv; - if (elements < 0) { - if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) { - return NULL; - } - } else { - /* - * Just make sure it is a valid list. - */ - - int listTest; - - if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) { - return NULL; - } + if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) { + return NULL; + } - /* - * Correct this if it is too large, otherwise we will waste our time - * joining null elements to the path. - */ + elements = ((elements >= 0) && (elements <= objc)) ? elements : objc; + copy = TclListObjCopy(NULL, listObj); + Tcl_ListObjGetElements(NULL, listObj, &objc, &objv); + res = TclJoinPath(elements, objv); + Tcl_DecrRefCount(copy); + return res; +} - if (elements > listTest) { - elements = listTest; - } - } +Tcl_Obj * +TclJoinPath( + int elements, + Tcl_Obj * const objv[]) +{ + Tcl_Obj *res; + int i; + const Tcl_Filesystem *fsPtr = NULL; res = NULL; for (i = 0; i < elements; i++) { - Tcl_Obj *elt; - int driveNameLength; + int driveNameLength, strEltLen, length; Tcl_PathType type; - char *strElt; - int strEltLen; - int length; - char *ptr; + char *strElt, *ptr; Tcl_Obj *driveName = NULL; - - Tcl_ListObjIndex(NULL, listObj, i, &elt); + Tcl_Obj *elt = objv[i]; /* * This is a special case where we can be much more efficient, where @@ -817,18 +871,17 @@ Tcl_FSJoinPath(listObj, elements) * could expand that in the future. */ - if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType) - && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) { - Tcl_Obj *tail; - Tcl_PathType type; + if ((i == (elements-2)) && (i == 0) + && (elt->typePtr == &tclFsPathType) + && !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))) { + Tcl_Obj *tailObj = objv[i+1]; - Tcl_ListObjIndex(NULL, listObj, i+1, &tail); - type = TclGetPathType(tail, NULL, NULL, NULL); + type = TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { - CONST char *str; + const char *str; int len; - str = Tcl_GetStringFromObj(tail, &len); + str = Tcl_GetStringFromObj(tailObj, &len); if (len == 0) { /* * This happens if we try to handle the root volume '/'. @@ -843,7 +896,7 @@ Tcl_FSJoinPath(listObj, elements) } /* - * 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 @@ -870,24 +923,22 @@ Tcl_FSJoinPath(listObj, elements) /* * Otherwise we don't have an easy join, and we must let the - * more general code below handle things + * more general code below handle things. */ } else if (tclPlatform == TCL_PLATFORM_UNIX) { if (res != NULL) { TclDecrRefCount(res); } - return tail; + return tailObj; } else { - CONST char *str; - int len; + const char *str = TclGetString(tailObj); - str = Tcl_GetStringFromObj(tail, &len); if (tclPlatform == TCL_PLATFORM_WINDOWS) { if (strchr(str, '\\') == NULL) { if (res != NULL) { TclDecrRefCount(res); } - return tail; + return tailObj; } } } @@ -923,20 +974,22 @@ Tcl_FSJoinPath(listObj, elements) res = Tcl_NewStringObj(strElt, driveNameLength); } strElt += driveNameLength; + } else if (driveName != NULL) { + Tcl_DecrRefCount(driveName); } /* * Optimisation block: if this is the last element to be examined, and * it is absolute or the only element, and the drive-prefix was ok (if * there is one), it might be that the path is already in a suitable - * form to be returned. Then we can short-cut the rest of this + * form to be returned. Then we can short-cut the rest of this * function. */ if ((driveName == NULL) && (i == (elements - 1)) && (type != TCL_PATH_RELATIVE || res == NULL)) { /* - * It's the last path segment. Perform a quick check if the path + * It's the last path segment. Perform a quick check if the path * is already in a suitable form. */ @@ -952,6 +1005,7 @@ Tcl_FSJoinPath(listObj, elements) * We have a repeated file separator, which means the path * is not in normalized form */ + goto noQuickReturn; } ptr++; @@ -961,8 +1015,8 @@ Tcl_FSJoinPath(listObj, elements) } /* - * 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; @@ -974,7 +1028,6 @@ Tcl_FSJoinPath(listObj, elements) */ noQuickReturn: - if (res == NULL) { res = Tcl_NewObj(); ptr = Tcl_GetStringFromObj(res, &length); @@ -1009,15 +1062,22 @@ Tcl_FSJoinPath(listObj, elements) int needsSep = 0; if (fsPtr->filesystemSeparatorProc != NULL) { - Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res); + Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(res); + if (sep != NULL) { separator = TclGetString(sep)[0]; } + /* Safety check in case the VFS driver caused sharing */ + if (Tcl_IsShared(res)) { + TclDecrRefCount(res); + res = Tcl_DuplicateObj(res); + Tcl_IncrRefCount(res); + } } if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); - length++; + Tcl_GetStringFromObj(res, &length); } Tcl_SetObjLength(res, length + (int) strlen(strElt)); @@ -1069,56 +1129,55 @@ Tcl_FSJoinPath(listObj, elements) */ int -Tcl_FSConvertToPathType(interp, pathPtr) - Tcl_Interp *interp; /* Interpreter in which to store error message +Tcl_FSConvertToPathType( + Tcl_Interp *interp, /* Interpreter in which to store error message * (if necessary). */ - Tcl_Obj *pathPtr; /* Object to convert to a valid, current path + Tcl_Obj *pathPtr) /* Object to convert to a valid, current path * type. */ { /* * While it is bad practice to examine an object's type directly, this is - * actually the best thing to do here. The reason is that if we are + * actually the best thing to do here. The reason is that if we are * converting this object to FsPath type for the first time, we don't need - * to worry whether the 'cwd' has changed. On the other hand, if this + * to worry whether the 'cwd' has changed. On the other hand, if this * object is already of FsPath type, and is a relative path, we do have to - * worry about the cwd. If the cwd has changed, we must recompute the + * worry about the cwd. If the cwd has changed, we must recompute the * path. */ if (pathPtr->typePtr == &tclFsPathType) { - FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); - if (!TclFSEpochOk(fsPathPtr->filesystemEpoch)) { - if (pathPtr->bytes == NULL) { - UpdateStringOfFsPath(pathPtr); - } - FreeFsPathInternalRep(pathPtr); - pathPtr->typePtr = NULL; - return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) { + return TCL_OK; } - return TCL_OK; - /* - * We used to have more complex code here: - * - * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) { - * return TCL_OK; - * } else { - * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { - * return TCL_OK; - * } else { - * if (pathPtr->bytes == NULL) { - * UpdateStringOfFsPath(pathPtr); - * } - * FreeFsPathInternalRep(pathPtr); - * pathPtr->typePtr = NULL; - * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); - * } - * } - * - * But we no longer believe this is necessary. - */ - } else { - return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + + if (pathPtr->bytes == NULL) { + UpdateStringOfFsPath(pathPtr); + } + FreeFsPathInternalRep(pathPtr); } + + return SetFsPathFromAny(interp, pathPtr); + + /* + * We used to have more complex code here: + * + * FsPath *fsPathPtr = PATHOBJ(pathPtr); + * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) { + * return TCL_OK; + * } else { + * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { + * return TCL_OK; + * } else { + * if (pathPtr->bytes == NULL) { + * UpdateStringOfFsPath(pathPtr); + * } + * FreeFsPathInternalRep(pathPtr); + * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + * } + * } + * + * But we no longer believe this is necessary. + */ } /* @@ -1126,8 +1185,8 @@ Tcl_FSConvertToPathType(interp, pathPtr) */ static int -IsSeparatorOrNull(ch) - int ch; +IsSeparatorOrNull( + int ch) { if (ch == 0) { return 1; @@ -1142,15 +1201,15 @@ IsSeparatorOrNull(ch) } /* - * Helper function for SetFsPathFromAny. Returns position of first directory - * delimiter in the path. If no separator is found, then returns the position + * Helper function for SetFsPathFromAny. Returns position of first directory + * delimiter in the path. If no separator is found, then returns the position * of the end of the string. */ static int -FindSplitPos(path, separator) - CONST char *path; - int separator; +FindSplitPos( + const char *path, + int separator) { int count = 0; switch (tclPlatform) { @@ -1186,28 +1245,54 @@ FindSplitPos(path, separator) * 'file dirname', 'file tail', etc. * * Assumptions: - * 'dirPtr' must be an absolute path. 'len' may not be zero. + * 'dirPtr' must be an absolute path. 'len' may not be zero. * * Results: * The new Tcl object, with refCount zero. * * Side effects: - * Memory is allocated. 'dirPtr' gets an additional refCount. + * Memory is allocated. 'dirPtr' gets an additional refCount. * *--------------------------------------------------------------------------- */ -Tcl_Obj* -TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) +Tcl_Obj * +TclNewFSPathObj( + Tcl_Obj *dirPtr, + const char *addStrRep, + int len) { FsPath *fsPathPtr; Tcl_Obj *pathPtr; - ThreadSpecificData *tsdPtr; + const char *p; + int state = 0, count = 0; + + /* [Bug 2806250] - this is only a partial solution of the problem. + * The PATHFLAGS != 0 representation assumes in many places that + * the "tail" part stored in the normPathPtr field is itself a + * relative path. Strings that begin with "~" are not relative paths, + * so we must prevent their storage in the normPathPtr field. + * + * More generally we ought to be testing "addStrRep" for any value + * that is not a relative path, but in an unconstrained VFS world + * that could be just about anything, and testing could be expensive. + * Since this routine plays a big role in [glob], anything that slows + * it down would be unwelcome. For now, continue the risk of further + * bugs when some Tcl_Filesystem uses otherwise relative path strings + * as absolute path strings. Sensible Tcl_Filesystems will avoid + * that by mounting on path prefixes like foo:// which cannot be the + * name of a file or directory read from a native [glob] operation. + */ + if (addStrRep[0] == '~') { + Tcl_Obj *tail = Tcl_NewStringObj(addStrRep, len); - tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + pathPtr = AppendPath(dirPtr, tail); + Tcl_DecrRefCount(tail); + return pathPtr; + } pathPtr = Tcl_NewObj(); - fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); + fsPathPtr = ckalloc(sizeof(FsPath)); /* * Set up the path. @@ -1219,17 +1304,82 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) fsPathPtr->cwdPtr = dirPtr; Tcl_IncrRefCount(dirPtr); fsPathPtr->nativePathPtr = NULL; - fsPathPtr->fsRecPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->fsPtr = NULL; + fsPathPtr->filesystemEpoch = 0; - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = TCLPATH_APPENDED; pathPtr->typePtr = &tclFsPathType; pathPtr->bytes = NULL; pathPtr->length = 0; + /* + * Look for path components made up of only "." + * This is overly conservative analysis to keep simple. It may mark some + * things as needing more aggressive normalization that don't actually + * need it. No harm done. + */ + for (p = addStrRep; len > 0; p++, len--) { + switch (state) { + case 0: /* So far only "." since last dirsep or start */ + switch (*p) { + case '.': + count++; + break; + case '/': + case '\\': + case ':': + if (count) { + PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM; + len = 0; + } + break; + default: + count = 0; + state = 1; + } + case 1: /* Scanning for next dirsep */ + switch (*p) { + case '/': + case '\\': + case ':': + state = 0; + break; + } + } + } + if (len == 0 && count) { + PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM; + } + return pathPtr; } + +static Tcl_Obj * +AppendPath( + Tcl_Obj *head, + Tcl_Obj *tail) +{ + int numBytes; + const char *bytes; + Tcl_Obj *copy = Tcl_DuplicateObj(head); + + /* + * This is likely buggy when dealing with virtual filesystem drivers + * that use some character other than "/" as a path separator. I know + * of no evidence that such a foolish thing exists. This solution was + * chosen so that "JoinPath" operations that pass through either path + * intrep produce the same results; that is, bugward compatibility. If + * we need to fix that bug here, it needs fixing in TclJoinPath() too. + */ + bytes = Tcl_GetStringFromObj(tail, &numBytes); + if (numBytes == 0) { + Tcl_AppendToObj(copy, "/", 1); + } else { + TclpNativeJoinPath(copy, bytes); + } + return copy; +} /* *--------------------------------------------------------------------------- @@ -1240,15 +1390,9 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) * * Takes a path and a directory, where we _assume_ both path and * directory are absolute, normalized and that the path lies inside the - * directory. Returns a Tcl_Obj representing filename of the path + * directory. Returns a Tcl_Obj representing filename of the path * relative to the directory. * - * In the case where the resulting path would start with a '~', we take - * special care to return an ordinary string. This means to use that - * path (and not have it interpreted as a user name), one must prepend - * './'. This may seem strange, but that is how 'glob' is currently - * defined. - * * Results: * NULL on error, otherwise a valid object, typically with refCount of * zero, which it is assumed the caller will increment. @@ -1259,73 +1403,20 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) *--------------------------------------------------------------------------- */ -Tcl_Obj* -TclFSMakePathRelative(interp, pathPtr, cwdPtr) - 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. */ +Tcl_Obj * +TclFSMakePathRelative( + 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; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + const char *tempStr; if (pathPtr->typePtr == &tclFsPathType) { - FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); - if (PATHFLAGS(pathPtr) != 0 - && fsPathPtr->cwdPtr == cwdPtr) { - pathPtr = fsPathPtr->normPathPtr; - - /* - * Free old representation. - */ - - if (pathPtr->typePtr != NULL) { - if (pathPtr->bytes == NULL) { - if (pathPtr->typePtr->updateStringProc == NULL) { - if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't find object", - "string representation", (char *) NULL); - } - return NULL; - } - pathPtr->typePtr->updateStringProc(pathPtr); - } - TclFreeIntRep(pathPtr); - } + FsPath *fsPathPtr = PATHOBJ(pathPtr); - /* - * Now pathPtr is a string object. - */ - - if (Tcl_GetString(pathPtr)[0] == '~') { - /* - * If the first character of the path is a tilde, we must just - * return the path as is, to agree with the defined behaviour - * of 'glob'. - */ - return pathPtr; - } - - fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); - - /* - * Circular reference, by design. - */ - - fsPathPtr->translatedPathPtr = pathPtr; - fsPathPtr->normPathPtr = NULL; - fsPathPtr->cwdPtr = cwdPtr; - Tcl_IncrRefCount(cwdPtr); - fsPathPtr->nativePathPtr = NULL; - fsPathPtr->fsRecPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; - PATHFLAGS(pathPtr) = 0; - pathPtr->typePtr = &tclFsPathType; - - return pathPtr; + if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { + return fsPathPtr->normPathPtr; } } @@ -1368,7 +1459,7 @@ TclFSMakePathRelative(interp, pathPtr, cwdPtr) /* *--------------------------------------------------------------------------- * - * TclFSMakePathFromNormalized -- + * MakePathFromNormalized -- * * Like SetFsPathFromAny, but assumes the given object is an absolute * normalized path. Only for internal use. @@ -1382,15 +1473,12 @@ TclFSMakePathRelative(interp, pathPtr, cwdPtr) *--------------------------------------------------------------------------- */ -int -TclFSMakePathFromNormalized(interp, pathPtr, nativeRep) - Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - Tcl_Obj *pathPtr; /* The object to convert. */ - ClientData nativeRep; /* The native rep for the object, if known - * else NULL. */ +static int +MakePathFromNormalized( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; @@ -1404,9 +1492,10 @@ TclFSMakePathFromNormalized(interp, pathPtr, nativeRep) if (pathPtr->bytes == NULL) { if (pathPtr->typePtr->updateStringProc == NULL) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't find object", - "string representation", (char *) NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't find object string representation", -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF", + NULL); } return TCL_ERROR; } @@ -1415,7 +1504,7 @@ TclFSMakePathFromNormalized(interp, pathPtr, nativeRep) TclFreeIntRep(pathPtr); } - fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); + fsPathPtr = ckalloc(sizeof(FsPath)); /* * It's a pure normalized absolute path. @@ -1429,11 +1518,12 @@ TclFSMakePathFromNormalized(interp, pathPtr, nativeRep) fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; - fsPathPtr->nativePathPtr = nativeRep; - fsPathPtr->fsRecPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->nativePathPtr = NULL; + fsPathPtr->fsPtr = NULL; + /* Remember the epoch under which we decided pathPtr was normalized */ + fsPathPtr->filesystemEpoch = TclFSEpoch(); - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; @@ -1466,18 +1556,17 @@ TclFSMakePathFromNormalized(interp, pathPtr, nativeRep) */ Tcl_Obj * -Tcl_FSNewNativePath(fromFilesystem, clientData) - Tcl_Filesystem* fromFilesystem; - ClientData clientData; +Tcl_FSNewNativePath( + const Tcl_Filesystem *fromFilesystem, + ClientData clientData) { - Tcl_Obj *pathPtr; + Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; - FilesystemRecord *fsFromPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - pathPtr = TclFSInternalToNormalized(fromFilesystem, clientData, - &fsFromPtr); + if (fromFilesystem->internalToNormalizedProc != NULL) { + pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); + } if (pathPtr == NULL) { return NULL; } @@ -1497,7 +1586,7 @@ Tcl_FSNewNativePath(fromFilesystem, clientData) TclFreeIntRep(pathPtr); } - fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); + fsPathPtr = ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; @@ -1508,11 +1597,10 @@ Tcl_FSNewNativePath(fromFilesystem, clientData) fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; - fsPathPtr->fsRecPtr = fsFromPtr; - fsPathPtr->fsRecPtr->fileRefCount++; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->fsPtr = fromFilesystem; + fsPathPtr->filesystemEpoch = TclFSEpoch(); - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; @@ -1538,10 +1626,10 @@ Tcl_FSNewNativePath(fromFilesystem, clientData) *--------------------------------------------------------------------------- */ -Tcl_Obj* -Tcl_FSGetTranslatedPath(interp, pathPtr) - Tcl_Interp *interp; - Tcl_Obj* pathPtr; +Tcl_Obj * +Tcl_FSGetTranslatedPath( + Tcl_Interp *interp, + Tcl_Obj *pathPtr) { Tcl_Obj *retObj = NULL; FsPath *srcFsPathPtr; @@ -1549,14 +1637,37 @@ Tcl_FSGetTranslatedPath(interp, pathPtr) if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); if (srcFsPathPtr->translatedPathPtr == NULL) { if (PATHFLAGS(pathPtr) != 0) { - retObj = Tcl_FSGetNormalizedPath(interp, pathPtr); + /* + * We lack a translated path result, but we have a directory + * (cwdPtr) and a tail (normPathPtr), and if we join the + * translated version of cwdPtr to normPathPtr, we'll get the + * translated result we need, and can store it for future use. + */ + + Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp, + srcFsPathPtr->cwdPtr); + if (translatedCwdPtr == NULL) { + return NULL; + } + + retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1, + &srcFsPathPtr->normPathPtr); + srcFsPathPtr->translatedPathPtr = retObj; + if (translatedCwdPtr->typePtr == &tclFsPathType) { + srcFsPathPtr->filesystemEpoch + = PATHOBJ(translatedCwdPtr)->filesystemEpoch; + } else { + srcFsPathPtr->filesystemEpoch = 0; + } + Tcl_IncrRefCount(retObj); + Tcl_DecrRefCount(translatedCwdPtr); } else { /* - * It is a pure absolute, normalized path object. This is - * something like being a 'pure list'. The object's string, + * 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. */ @@ -1570,7 +1681,9 @@ Tcl_FSGetTranslatedPath(interp, pathPtr) retObj = srcFsPathPtr->translatedPathPtr; } - Tcl_IncrRefCount(retObj); + if (retObj != NULL) { + Tcl_IncrRefCount(retObj); + } return retObj; } @@ -1593,20 +1706,19 @@ Tcl_FSGetTranslatedPath(interp, pathPtr) *--------------------------------------------------------------------------- */ -CONST char* -Tcl_FSGetTranslatedStringPath(interp, pathPtr) - Tcl_Interp *interp; - Tcl_Obj* pathPtr; +const char * +Tcl_FSGetTranslatedStringPath( + Tcl_Interp *interp, + Tcl_Obj *pathPtr) { Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr != NULL) { int len; - CONST char *result, *orig; + const char *orig = Tcl_GetStringFromObj(transPtr, &len); + char *result = ckalloc(len+1); - orig = Tcl_GetStringFromObj(transPtr, &len); - result = (char*) ckalloc((unsigned)(len+1)); - memcpy((VOID*) result, (VOID*) orig, (size_t) (len+1)); + memcpy(result, orig, (size_t) len+1); TclDecrRefCount(transPtr); return result; } @@ -1627,23 +1739,23 @@ Tcl_FSGetTranslatedStringPath(interp, pathPtr) * NULL or a valid path object pointer. * * Side effects: - * New memory may be allocated. The Tcl 'errno' may be modified in the + * New memory may be allocated. The Tcl 'errno' may be modified in the * process of trying to examine various path possibilities. * *--------------------------------------------------------------------------- */ -Tcl_Obj* -Tcl_FSGetNormalizedPath(interp, pathPtr) - Tcl_Interp *interp; - Tcl_Obj* pathPtr; +Tcl_Obj * +Tcl_FSGetNormalizedPath( + Tcl_Interp *interp, + Tcl_Obj *pathPtr) { FsPath *fsPathPtr; if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } - fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0) { /* @@ -1652,70 +1764,77 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) */ Tcl_Obj *dir, *copy; - int cwdLen; - int pathType; - CONST char *cwdStr; - ClientData clientData = NULL; + int tailLen, cwdLen, pathType; pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); if (dir == NULL) { return NULL; } + /* TODO: Figure out why this is needed. */ if (pathPtr->bytes == NULL) { UpdateStringOfFsPath(pathPtr); } - copy = Tcl_DuplicateObj(dir); - Tcl_IncrRefCount(copy); + + Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen); + if (tailLen) { + copy = AppendPath(dir, fsPathPtr->normPathPtr); + } else { + copy = Tcl_DuplicateObj(dir); + } Tcl_IncrRefCount(dir); + Tcl_IncrRefCount(copy); /* * We now own a reference on both 'dir' and 'copy' */ - cwdStr = Tcl_GetStringFromObj(copy, &cwdLen); + (void) Tcl_GetStringFromObj(dir, &cwdLen); + cwdLen += (Tcl_GetString(copy)[cwdLen] == '/'); - /* - * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about - * the Windows special case? Perhaps we should just check if cwd is a - * root volume. We should never get cwdLen == 0 in this code path. - */ + /* Normalize the combined string. */ - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - if (cwdStr[cwdLen-1] != '/') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; - case TCL_PLATFORM_WINDOWS: - if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; - } - Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr); + if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) { + /* + * If the "tail" part has components (like /../) that cause the + * combined path to need more complete normalizing, call on the + * more powerful routine to accomplish that so we avoid [Bug + * 2385549] ... + */ - /* - * Normalize the combined string, but only starting after the end of - * the previously normalized 'dir'. This should be much faster! We - * use 'cwdLen-1' so that we are already pointing at the dir-separator - * that we know about. The normalization code will actually start off - * directly after that separator. - */ + Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy); - TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); + Tcl_DecrRefCount(copy); + copy = newCopy; + } else { + /* + * ... but in most cases where we join a trouble free tail to a + * normalized head, we can more efficiently normalize the combined + * path by passing over only the unnormalized tail portion. When + * this is sufficient, prior developers claim this should be much + * faster. We use 'cwdLen-1' so that we are already pointing at + * the dir-separator that we know about. The normalization code + * will actually start off directly after that separator. + */ - /* - * Now we need to construct the new path object - */ + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1); + } + + /* Now we need to construct the new path object. */ if (pathType == TCL_PATH_RELATIVE) { - FsPath* origDirFsPathPtr; Tcl_Obj *origDir = fsPathPtr->cwdPtr; - origDirFsPathPtr = (FsPath*) PATHOBJ(origDir); + + /* + * NOTE: here we are (dangerously?) assuming that origDir points + * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType. The + * pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); + * above that set the pathType value should have established that, + * but it's far less clear on what basis we know there's been no + * shimmering since then. + */ + + FsPath *origDirFsPathPtr = PATHOBJ(origDir); fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr; Tcl_IncrRefCount(fsPathPtr->cwdPtr); @@ -1741,9 +1860,6 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) TclDecrRefCount(dir); } - if (clientData != NULL) { - fsPathPtr->nativePathPtr = clientData; - } PATHFLAGS(pathPtr) = 0; } @@ -1757,60 +1873,32 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) UpdateStringOfFsPath(pathPtr); } FreeFsPathInternalRep(pathPtr); - pathPtr->typePtr = NULL; - if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) { + if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) { return NULL; } - fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + fsPathPtr = PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { int cwdLen; Tcl_Obj *copy; - CONST char *cwdStr; - ClientData clientData = NULL; - - copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr); - Tcl_IncrRefCount(copy); - cwdStr = Tcl_GetStringFromObj(copy, &cwdLen); - /* - * Should we perhaps use 'Tcl_FSPathSeparator'? But then what - * about the Windows special case? Perhaps we should just check - * if cwd is a root volume. We should never get cwdLen == 0 in - * this code path. - */ + copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - if (cwdStr[cwdLen-1] != '/') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; - case TCL_PLATFORM_WINDOWS: - if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; - } - Tcl_AppendObjToObj(copy, pathPtr); + (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); + cwdLen += (Tcl_GetString(copy)[cwdLen] == '/'); /* * Normalize the combined string, but only starting after the end * of the previously normalized 'dir'. This should be much faster! */ - TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1); fsPathPtr->normPathPtr = copy; - if (clientData != NULL) { - fsPathPtr->nativePathPtr = clientData; - } + Tcl_IncrRefCount(fsPathPtr->normPathPtr); } } if (fsPathPtr->normPathPtr == NULL) { - ClientData clientData = NULL; Tcl_Obj *useThisCwd = NULL; + int pureNormalized = 1; /* * Since normPathPtr is NULL, but this is a valid path object, we know @@ -1818,7 +1906,9 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) */ Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr; - CONST char *path = TclGetString(absolutePath); + const char *path = TclGetString(absolutePath); + + Tcl_IncrRefCount(absolutePath); /* * We have to be a little bit careful here to avoid infinite loops @@ -1827,7 +1917,20 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) * might loop back through here. */ - if (path[0] != '\0') { + if (path[0] == '\0') { + /* + * Special handling for the empty string value. This one is very + * weird with [file normalize {}] => {}. (The reasoning supporting + * this is unknown to DGP, but he fears changing it.) Attempt here + * to keep the expectations of other parts of Tcl_Filesystem code + * about state of the FsPath fields satisfied. + * + * In particular, capture the cwd value and save so it can be + * stored in the cwdPtr field below. + */ + + useThisCwd = Tcl_FSGetCwd(interp); + } else { /* * We don't ask for the type of 'pathPtr' here, because that is * not correct for our purposes when we have a path like '~'. Tcl @@ -1845,23 +1948,28 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) return NULL; } + pureNormalized = 0; + Tcl_DecrRefCount(absolutePath); absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); Tcl_IncrRefCount(absolutePath); /* * We have a refCount on the cwd. */ -#ifdef __WIN32__ +#ifdef _WIN32 } else if (type == TCL_PATH_VOLUME_RELATIVE) { /* * Only Windows has volume-relative paths. */ + + Tcl_DecrRefCount(absolutePath); absolutePath = TclWinVolumeRelativeNormalize(interp, path, &useThisCwd); if (absolutePath == NULL) { return NULL; } -#endif /* __WIN32__ */ + pureNormalized = 0; +#endif /* _WIN32 */ } } @@ -1870,21 +1978,20 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) */ fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, - absolutePath, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); - if (0 && (clientData != NULL)) { - fsPathPtr->nativePathPtr = - (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData); - } + absolutePath); /* * Check if path is pure normalized (this can only be the case if it * is an absolute path). */ - if (useThisCwd == NULL) { - if (!strcmp(TclGetString(fsPathPtr->normPathPtr), - TclGetString(pathPtr))) { + if (pureNormalized) { + int normPathLen, pathLen; + const char *normPath; + + path = TclGetStringFromObj(pathPtr, &pathLen); + normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen); + if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) { /* * The path was already normalized. Get rid of the duplicate. */ @@ -1898,16 +2005,17 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) fsPathPtr->normPathPtr = pathPtr; } - } else { + } + if (useThisCwd != NULL) { /* * We just need to free an object we allocated above for relative * paths (this was returned by Tcl_FSJoinToPath above), and then * of course store the cwd. */ - TclDecrRefCount(absolutePath); fsPathPtr->cwdPtr = useThisCwd; } + TclDecrRefCount(absolutePath); } return fsPathPtr->normPathPtr; @@ -1919,7 +2027,7 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) * Tcl_FSGetInternalRep -- * * Extract the internal representation of a given path object, in the - * given filesystem. If the path object belongs to a different + * given filesystem. If the path object belongs to a different * filesystem, we return NULL. * * If the internal representation is currently NULL, we attempt to @@ -1936,38 +2044,38 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) */ ClientData -Tcl_FSGetInternalRep(pathPtr, fsPtr) - Tcl_Obj* pathPtr; - Tcl_Filesystem *fsPtr; +Tcl_FSGetInternalRep( + Tcl_Obj *pathPtr, + const Tcl_Filesystem *fsPtr) { - FsPath* srcFsPathPtr; + FsPath *srcFsPathPtr; if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { return NULL; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); /* * We will only return the native representation for the caller's - * 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. + * 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 easily achievable with the current implementation. */ - if (srcFsPathPtr->fsRecPtr == NULL) { + if (srcFsPathPtr->fsPtr == NULL) { /* * This only usually happens in wrappers like TclpStat which create a * string object and pass it to TclpObjStat. Code which calls the * 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 + * to allow external code to call the native filesystem directly. It * is at least safer to allow this sub-optimal routing. */ @@ -1980,8 +2088,8 @@ Tcl_FSGetInternalRep(pathPtr, fsPtr) * (e.g. from the Tcl testsuite). */ - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); - if (srcFsPathPtr->fsRecPtr == NULL) { + srcFsPathPtr = PATHOBJ(pathPtr); + if (srcFsPathPtr->fsPtr == NULL) { return NULL; } } @@ -1989,12 +2097,12 @@ Tcl_FSGetInternalRep(pathPtr, fsPtr) /* * 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. + * 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->fsRecPtr->fsPtr) { - Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr); + if (fsPtr != srcFsPathPtr->fsPtr) { + const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr); if (actualFs == fsPtr) { return Tcl_FSGetInternalRep(pathPtr, fsPtr); @@ -2004,12 +2112,16 @@ Tcl_FSGetInternalRep(pathPtr, fsPtr) if (srcFsPathPtr->nativePathPtr == NULL) { Tcl_FSCreateInternalRepProc *proc; - proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc; + char *nativePathPtr; + proc = srcFsPathPtr->fsPtr->createInternalRepProc; if (proc == NULL) { return NULL; } - srcFsPathPtr->nativePathPtr = (*proc)(pathPtr); + + nativePathPtr = proc(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); + srcFsPathPtr->nativePathPtr = nativePathPtr; } return srcFsPathPtr->nativePathPtr; @@ -2034,17 +2146,17 @@ Tcl_FSGetInternalRep(pathPtr, fsPtr) */ int -TclFSEnsureEpochOk(pathPtr, fsPtrPtr) - Tcl_Obj* pathPtr; - Tcl_Filesystem **fsPtrPtr; +TclFSEnsureEpochOk( + Tcl_Obj *pathPtr, + const Tcl_Filesystem **fsPtrPtr) { - FsPath* srcFsPathPtr; + FsPath *srcFsPathPtr; if (pathPtr->typePtr != &tclFsPathType) { return TCL_OK; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); /* * Check if the filesystem has changed in some way since this object's @@ -2060,19 +2172,18 @@ TclFSEnsureEpochOk(pathPtr, fsPtrPtr) UpdateStringOfFsPath(pathPtr); } FreeFsPathInternalRep(pathPtr); - pathPtr->typePtr = NULL; if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return TCL_ERROR; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); } /* * Check whether the object is already assigned to a fs. */ - if (srcFsPathPtr->fsRecPtr != NULL) { - *fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr; + if (srcFsPathPtr->fsPtr != NULL) { + *fsPtrPtr = srcFsPathPtr->fsPtr; } return TCL_OK; } @@ -2094,13 +2205,12 @@ TclFSEnsureEpochOk(pathPtr, fsPtrPtr) */ void -TclFSSetPathDetails(pathPtr, fsRecPtr, clientData) - Tcl_Obj *pathPtr; - FilesystemRecord *fsRecPtr; - ClientData clientData; +TclFSSetPathDetails( + Tcl_Obj *pathPtr, + const Tcl_Filesystem *fsPtr, + ClientData clientData) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - FsPath* srcFsPathPtr; + FsPath *srcFsPathPtr; /* * Make sure pathPtr is of the correct type. @@ -2112,11 +2222,10 @@ TclFSSetPathDetails(pathPtr, fsRecPtr, clientData) } } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); - srcFsPathPtr->fsRecPtr = fsRecPtr; + srcFsPathPtr = PATHOBJ(pathPtr); + srcFsPathPtr->fsPtr = fsPtr; srcFsPathPtr->nativePathPtr = clientData; - srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - fsRecPtr->fileRefCount++; + srcFsPathPtr->filesystemEpoch = TclFSEpoch(); } /* @@ -2137,11 +2246,11 @@ TclFSSetPathDetails(pathPtr, fsRecPtr, clientData) */ int -Tcl_FSEqualPaths(firstPtr, secondPtr) - Tcl_Obj* firstPtr; - Tcl_Obj* secondPtr; +Tcl_FSEqualPaths( + Tcl_Obj *firstPtr, + Tcl_Obj *secondPtr) { - char *firstStr, *secondStr; + const char *firstStr, *secondStr; int firstLen, secondLen, tempErrno; if (firstPtr == secondPtr) { @@ -2151,9 +2260,9 @@ Tcl_FSEqualPaths(firstPtr, secondPtr) if (firstPtr == NULL || secondPtr == NULL) { return 0; } - firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); - secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); - if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) { + firstStr = TclGetStringFromObj(firstPtr, &firstLen); + secondStr = TclGetStringFromObj(secondPtr, &secondLen); + if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) { return 1; } @@ -2171,9 +2280,9 @@ Tcl_FSEqualPaths(firstPtr, secondPtr) return 0; } - firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); - secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); - return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0); + firstStr = TclGetStringFromObj(firstPtr, &firstLen); + secondStr = TclGetStringFromObj(secondPtr, &secondLen); + return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)); } /* @@ -2197,15 +2306,14 @@ Tcl_FSEqualPaths(firstPtr, secondPtr) */ static int -SetFsPathFromAny(interp, pathPtr) - Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - Tcl_Obj *pathPtr; /* The object to convert. */ +SetFsPathFromAny( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *pathPtr) /* The object to convert. */ { int len; FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; @@ -2232,14 +2340,16 @@ SetFsPathFromAny(interp, pathPtr) */ if (name[0] == '~') { - char *expandedUser; Tcl_DString temp; int split; - char separator='/'; + char separator = '/'; split = FindSplitPos(name, separator); if (split != len) { - /* We have multiple pieces '~user/foo/bar...' */ + /* + * We have multiple pieces '~user/foo/bar...' + */ + name[split] = '\0'; } @@ -2252,7 +2362,7 @@ SetFsPathFromAny(interp, pathPtr) * We have just '~' */ - CONST char *dir; + const char *dir; Tcl_DString dirString; if (split != len) { @@ -2262,9 +2372,11 @@ SetFsPathFromAny(interp, pathPtr) dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't find HOME environment ", - "variable to expand path", (char *) NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't find HOME environment variable to" + " expand path", -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", + "HOMELESS", NULL); } return TCL_ERROR; } @@ -2279,9 +2391,10 @@ SetFsPathFromAny(interp, pathPtr) Tcl_DStringInit(&temp); if (TclpGetUserHome(name+1, &temp) == NULL) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "user \"", (name+1), - "\" doesn't exist", (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "user \"%s\" doesn't exist", name+1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", + NULL); } Tcl_DStringFree(&temp); if (split != len) { @@ -2294,8 +2407,7 @@ SetFsPathFromAny(interp, pathPtr) } } - expandedUser = Tcl_DStringValue(&temp); - transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp)); + transPtr = TclDStringToObj(&temp); if (split != len) { /* @@ -2321,7 +2433,7 @@ SetFsPathFromAny(interp, pathPtr) objc--; objv++; while (objc--) { - TclpNativeJoinPath(transPtr, TclGetString(*objv++)); + TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++)); } TclDecrRefCount(parts); } else { @@ -2340,65 +2452,46 @@ SetFsPathFromAny(interp, pathPtr) transPtr = joined; } } - Tcl_DStringFree(&temp); } else { - transPtr = Tcl_FSJoinToPath(pathPtr, 0, NULL); - } - -#if defined(__CYGWIN__) && defined(__WIN32__) - { - extern int cygwin_conv_to_win32_path(CONST char *, char *); - char winbuf[MAX_PATH+1]; - - /* - * In the Cygwin world, call conv_to_win32_path in order to use the - * mount table to translate the file name into something Windows will - * understand. Take care when converting empty strings! - */ - - name = Tcl_GetStringFromObj(transPtr, &len); - if (len > 0) { - cygwin_conv_to_win32_path(name, winbuf); - TclWinNoBackslash(winbuf); - Tcl_SetStringObj(transPtr, winbuf, -1); - } + transPtr = TclJoinPath(1, &pathPtr); } -#endif /* __CYGWIN__ && __WIN32__ */ /* * Now we have a translated filename in 'transPtr'. This will have forward * slashes on Windows, and will not contain any ~user sequences. */ - fsPathPtr = (FsPath *) ckalloc((unsigned)sizeof(FsPath)); + fsPathPtr = ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = transPtr; if (transPtr != pathPtr) { Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); + /* Redo translation when $env(HOME) changes */ + fsPathPtr->filesystemEpoch = TclFSEpoch(); + } else { + fsPathPtr->filesystemEpoch = 0; } fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; - fsPathPtr->fsRecPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->fsPtr = NULL; /* * Free old representation before installing our new one. */ TclFreeIntRep(pathPtr); - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; - return TCL_OK; } static void -FreeFsPathInternalRep(pathPtr) - Tcl_Obj *pathPtr; /* Path object with internal rep to free. */ +FreeFsPathInternalRep( + Tcl_Obj *pathPtr) /* Path object with internal rep to free. */ { - FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + FsPath *fsPathPtr = PATHOBJ(pathPtr); if (fsPathPtr->translatedPathPtr != NULL) { if (fsPathPtr->translatedPathPtr != pathPtr) { @@ -2414,83 +2507,73 @@ FreeFsPathInternalRep(pathPtr) if (fsPathPtr->cwdPtr != NULL) { TclDecrRefCount(fsPathPtr->cwdPtr); } - if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsRecPtr != NULL) { + if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) { Tcl_FSFreeInternalRepProc *freeProc = - fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc; + fsPathPtr->fsPtr->freeInternalRepProc; + if (freeProc != NULL) { - (*freeProc)(fsPathPtr->nativePathPtr); + freeProc(fsPathPtr->nativePathPtr); fsPathPtr->nativePathPtr = NULL; } } - if (fsPathPtr->fsRecPtr != NULL) { - fsPathPtr->fsRecPtr->fileRefCount--; - if (fsPathPtr->fsRecPtr->fileRefCount <= 0) { - /* - * It has been unregistered already. - */ - - ckfree((char *) fsPathPtr->fsRecPtr); - } - } - ckfree((char*) fsPathPtr); + ckfree(fsPathPtr); + pathPtr->typePtr = NULL; } static void -DupFsPathInternalRep(srcPtr, copyPtr) - Tcl_Obj *srcPtr; /* Path obj with internal rep to copy. */ - Tcl_Obj *copyPtr; /* Path obj with internal rep to set. */ +DupFsPathInternalRep( + Tcl_Obj *srcPtr, /* Path obj with internal rep to copy. */ + Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */ { - FsPath* srcFsPathPtr = (FsPath*) PATHOBJ(srcPtr); - FsPath* copyFsPathPtr = (FsPath*) ckalloc((unsigned)sizeof(FsPath)); + FsPath *srcFsPathPtr = PATHOBJ(srcPtr); + FsPath *copyFsPathPtr = ckalloc(sizeof(FsPath)); - PATHOBJ(copyPtr) = (VOID *) copyFsPathPtr; + SETPATHOBJ(copyPtr, copyFsPathPtr); - if (srcFsPathPtr->translatedPathPtr != NULL) { + if (srcFsPathPtr->translatedPathPtr == srcPtr) { + /* Cycle in src -> make cycle in copy. */ + copyFsPathPtr->translatedPathPtr = copyPtr; + } else { copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; - if (copyFsPathPtr->translatedPathPtr != copyPtr) { + if (copyFsPathPtr->translatedPathPtr != NULL) { Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr); } - } else { - copyFsPathPtr->translatedPathPtr = NULL; } - if (srcFsPathPtr->normPathPtr != NULL) { + if (srcFsPathPtr->normPathPtr == srcPtr) { + /* Cycle in src -> make cycle in copy. */ + copyFsPathPtr->normPathPtr = copyPtr; + } else { copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr; - if (copyFsPathPtr->normPathPtr != copyPtr) { + if (copyFsPathPtr->normPathPtr != NULL) { Tcl_IncrRefCount(copyFsPathPtr->normPathPtr); } - } else { - copyFsPathPtr->normPathPtr = NULL; } - if (srcFsPathPtr->cwdPtr != NULL) { - copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr; + copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr; + if (copyFsPathPtr->cwdPtr != NULL) { Tcl_IncrRefCount(copyFsPathPtr->cwdPtr); - } else { - copyFsPathPtr->cwdPtr = NULL; } copyFsPathPtr->flags = srcFsPathPtr->flags; - if (srcFsPathPtr->fsRecPtr != NULL + if (srcFsPathPtr->fsPtr != NULL && srcFsPathPtr->nativePathPtr != NULL) { Tcl_FSDupInternalRepProc *dupProc = - srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc; + srcFsPathPtr->fsPtr->dupInternalRepProc; + if (dupProc != NULL) { copyFsPathPtr->nativePathPtr = - (*dupProc)(srcFsPathPtr->nativePathPtr); + dupProc(srcFsPathPtr->nativePathPtr); } else { copyFsPathPtr->nativePathPtr = NULL; } } else { copyFsPathPtr->nativePathPtr = NULL; } - copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr; + copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; - if (copyFsPathPtr->fsRecPtr != NULL) { - copyFsPathPtr->fsRecPtr->fileRefCount++; - } copyPtr->typePtr = &tclFsPathType; } @@ -2512,11 +2595,10 @@ DupFsPathInternalRep(srcPtr, copyPtr) */ static void -UpdateStringOfFsPath(pathPtr) - register Tcl_Obj *pathPtr; /* path obj with string rep to update. */ +UpdateStringOfFsPath( + register Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { - FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); - CONST char *cwdStr; + FsPath *fsPathPtr = PATHOBJ(pathPtr); int cwdLen; Tcl_Obj *copy; @@ -2524,42 +2606,8 @@ UpdateStringOfFsPath(pathPtr) Tcl_Panic("Called UpdateStringOfFsPath with invalid object"); } - copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr); - Tcl_IncrRefCount(copy); - - cwdStr = Tcl_GetStringFromObj(copy, &cwdLen); - - /* - * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the - * Windows special case? Perhaps we should just check if cwd is a root - * volume. We should never get cwdLen == 0 in this code path. - */ + copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr); - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - if (cwdStr[cwdLen-1] != '/') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; - - case TCL_PLATFORM_WINDOWS: - /* - * We need the extra 'cwdLen != 2', and ':' checks because a volume - * relative path doesn't get a '/'. For example 'glob C:*cat*.exe' - * will return 'C:cat32.exe' - */ - - if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { - if (cwdLen != 2 || cwdStr[1] != ':') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - } - break; - } - - Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr); pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); pathPtr->length = cwdLen; copy->bytes = tclEmptyStringRep; @@ -2589,9 +2637,9 @@ UpdateStringOfFsPath(pathPtr) */ int -TclNativePathInFilesystem(pathPtr, clientDataPtr) - Tcl_Obj *pathPtr; - ClientData *clientDataPtr; +TclNativePathInFilesystem( + Tcl_Obj *pathPtr, + ClientData *clientDataPtr) { /* * A special case is required to handle the empty path "". This is a valid @@ -2605,8 +2653,10 @@ TclNativePathInFilesystem(pathPtr, clientDataPtr) /* * We reject the empty path "". */ + return -1; } + /* * Otherwise there is no way this path can be empty. */ @@ -2619,11 +2669,12 @@ TclNativePathInFilesystem(pathPtr, clientDataPtr) int len; - Tcl_GetStringFromObj(pathPtr, &len); + (void) Tcl_GetStringFromObj(pathPtr, &len); if (len == 0) { /* * We reject the empty path "". */ + return -1; } } |