diff options
Diffstat (limited to 'generic/tclPathObj.c')
| -rw-r--r-- | generic/tclPathObj.c | 1813 |
1 files changed, 932 insertions, 881 deletions
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 08491cc..362d489 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -1,23 +1,23 @@ -/* +/* * tclPathObj.c -- * - * This file contains the implementation of Tcl's "path" object - * type used to represent and manipulate a general (virtual) - * filesystem entity in an efficient manner. + * This file contains the implementation of Tcl's "path" object type used + * to represent and manipulate a general (virtual) filesystem entity in + * an efficient manner. * * Copyright (c) 2003 Vince Darley. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * 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.41 2005/05/10 18:34:47 kennykb Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.42 2005/07/21 14:38:50 dkf Exp $ */ #include "tclInt.h" #include "tclFileSystem.h" /* - * Prototypes for procedures defined later in this file. + * Prototypes for functions defined later in this file. */ static void DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, @@ -27,80 +27,76 @@ 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 int IsSeparatorOrNull _ANSI_ARGS_((int ch)); static Tcl_Obj* GetExtension _ANSI_ARGS_((Tcl_Obj *pathPtr)); /* - * Define the 'path' object type, which Tcl uses to represent - * file paths internally. + * Define the 'path' object type, which Tcl uses to represent file paths + * internally. */ Tcl_ObjType tclFsPathType = { "path", /* name */ FreeFsPathInternalRep, /* freeIntRepProc */ - DupFsPathInternalRep, /* dupIntRepProc */ + DupFsPathInternalRep, /* dupIntRepProc */ UpdateStringOfFsPath, /* updateStringProc */ SetFsPathFromAny /* setFromAnyProc */ }; -/* +/* * 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. - * + * + * 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). - * + * + * (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. - * + * + * Now, this is a path like 'file join $dir $tail' where, cwdPtr is the $dir + * and normPathPtr is the $tail. + * */ typedef struct FsPath { - Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. - * If this is NULL, then this is a - * pure normalized, absolute path - * object, in which the parent Tcl_Obj's - * string rep is already both translated - * and normalized. */ - Tcl_Obj *normPathPtr; /* Normalized absolute path, without - * ., .. or ~user sequences. If the - * Tcl_Obj containing - * this FsPath is already normalized, - * this may be a circular reference back - * to the container. If that is NOT the - * case, we have a refCount on the object. */ - Tcl_Obj *cwdPtr; /* If null, path is absolute, else - * this points to the cwd object used - * for this path. We have a refCount - * on the object. */ - int flags; /* Flags to describe interpretation - - * see below. */ - ClientData nativePathPtr; /* Native representation of this path, - * which 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. */ + Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this + * is NULL, then this is a pure normalized, + * absolute path object, in which the parent + * Tcl_Obj's string rep is already both + * translated and normalized. */ + Tcl_Obj *normPathPtr; /* Normalized absolute path, without ., .. or + * ~user sequences. If the Tcl_Obj containing + * this FsPath is already normalized, this may + * be a circular reference back to the + * container. If that is NOT the case, we have + * a refCount on the object. */ + Tcl_Obj *cwdPtr; /* If null, path is absolute, else this points + * to the cwd object used for this path. We + * have a refCount on the object. */ + int flags; /* Flags to describe interpretation - see + * below. */ + ClientData nativePathPtr; /* Native representation of this path, which + * 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. */ + /* Pointer to the filesystem record entry to + * use for this path. */ } FsPath; /* @@ -109,9 +105,9 @@ typedef struct FsPath { #define TCLPATH_APPENDED 1 -/* - * Define some macros to give us convenient access to path-object - * specific fields. +/* + * Define some macros to give us convenient access to path-object specific + * fields. */ #define PATHOBJ(pathPtr) (pathPtr->internalRep.otherValuePtr) @@ -124,82 +120,78 @@ typedef struct FsPath { * * TclFSNormalizeAbsolutePath -- * - * Description: - * 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 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). - * - * The behaviour of this function if passed a non-absolute path - * is NOT defined. - * - * pathPtr may have a refCount of zero, or may be a shared - * object. + * 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 + * 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). + * + * The behaviour of this function if passed a non-absolute path is NOT + * defined. + * + * 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 of 1, which is + * therefore owned by the caller. It must be freed (with + * Tcl_DecrRefCount) by the caller when no longer needed. * * Side effects: * None (beyond the memory allocation for the result). * * Special note: * 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. + * Jean-Claude Wippler, but has since been totally rewritten by Vince + * Darley to deal with symbolic links. * *--------------------------------------------------------------------------- */ 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_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. */ { ClientData clientData = NULL; 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. */ + 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. */ Tcl_Obj *retVal = NULL; dirSep = TclGetString(pathPtr); - + if (tclPlatform == TCL_PLATFORM_WINDOWS) { - if (dirSep[0] != 0 && dirSep[1] == ':' && - (dirSep[2] == '/' || dirSep[2] == '\\')) { + if (dirSep[0] != 0 && dirSep[1] == ':' && + (dirSep[2] == '/' || dirSep[2] == '\\')) { /* Do nothing */ - } else if ((dirSep[0] == '/' || dirSep[0] == '\\') - && (dirSep[1] == '/' || dirSep[1] == '\\')) { - /* - * UNC style path, where we must skip over the - * first separator, since the first two segments - * are actually inseparable. + } else if ((dirSep[0] == '/' || dirSep[0] == '\\') + && (dirSep[1] == '/' || dirSep[1] == '\\')) { + /* + * UNC style path, where we must skip over the first separator, + * since the first two segments are actually inseparable. */ + dirSep += 2; dirSep += FindSplitPos(dirSep, '/'); if (*dirSep != 0) { - dirSep++; + dirSep++; } } } - - /* - * Scan forward from one directory separator to the next, - * checking for '..' 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. + + /* + * Scan forward from one directory separator to the next, checking for + * '..' 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. */ while (*dirSep != 0) { @@ -207,7 +199,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) if (!first) { dirSep++; } - dirSep += FindSplitPos(dirSep, '/'); + dirSep += FindSplitPos(dirSep, '/'); if (dirSep[0] == 0 || dirSep[1] == 0) { if (retVal != NULL) { Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep); @@ -219,9 +211,12 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep); oldDirSep = dirSep; } - again: + again: if (IsSeparatorOrNull(dirSep[2])) { - /* Need to skip '.' in the path */ + /* + * Need to skip '.' in the path. + */ + if (retVal == NULL) { CONST char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); @@ -238,7 +233,11 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) Tcl_Obj *link; int curLen; char *linkStr; - /* Have '..' so need to skip previous directory */ + + /* + * Have '..' so need to skip previous directory. + */ + if (retVal == NULL) { CONST char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); @@ -247,35 +246,38 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) { link = Tcl_FSLink(retVal, NULL, 0); if (link != NULL) { - /* - * Got a link. Need to check if the link - * is relative or absolute, for those platforms - * where relative links exist. + /* + * 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) { - - /* - * 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. + /* + * 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 = Tcl_GetStringFromObj(retVal, &curLen); + while (--curLen >= 0) { - if (IsSeparatorOrNull(path[curLen])) { - break; - } + if (IsSeparatorOrNull(path[curLen])) { + break; + } } if (Tcl_IsShared(retVal)) { TclDecrRefCount(retVal); retVal = Tcl_DuplicateObj(retVal); Tcl_IncrRefCount(retVal); } - /* We want the trailing slash */ + + /* + * We want the trailing slash. + */ + Tcl_SetObjLength(retVal, curLen+1); Tcl_AppendObjToObj(retVal, link); TclDecrRefCount(link); @@ -288,7 +290,11 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) TclDecrRefCount(retVal); retVal = link; linkStr = Tcl_GetStringFromObj(retVal, &curLen); - /* Convert to forward-slashes on windows */ + + /* + * Convert to forward-slashes on windows. + */ + if (tclPlatform == TCL_PLATFORM_WINDOWS) { int i; for (i = 0; i < curLen; i++) { @@ -303,7 +309,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) } /* - * Either way, we now remove the last path element + * Either way, we now remove the last path element. */ while (--curLen >= 0) { @@ -326,40 +332,42 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep); } } - - /* - * If we didn't make any changes, just use the input path + + /* + * If we didn't make any changes, just use the input path. */ if (retVal == NULL) { retVal = pathPtr; Tcl_IncrRefCount(retVal); - + if (Tcl_IsShared(retVal)) { - /* - * 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. - * - * 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 could remove this code. + /* + * 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. + * + * 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 + * could remove this code. */ + TclDecrRefCount(retVal); retVal = Tcl_DuplicateObj(pathPtr); Tcl_IncrRefCount(retVal); } } - /* - * 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); + if (len == 2 && path[0] != 0 && path[1] == ':') { if (Tcl_IsShared(retVal)) { TclDecrRefCount(retVal); @@ -370,31 +378,33 @@ 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, 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). - * - * Virtual file systems which may be registered may have - * other criteria for normalizing a path. + /* + * Now we have an absolute path, with no '..', '.' sequences, but it still + * 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). + * + * Virtual file systems which may be registered may have other criteria + * for normalizing a path. */ TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData); - /* - * Since we know it is a normalized path, we can - * actually convert this object into an FsPath for - * greater efficiency + /* + * 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; } - /* This has a refCount of 1 for the caller */ + + /* + * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs. + */ + return retVal; } @@ -403,8 +413,8 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) * * Tcl_FSGetPathType -- * - * Determines whether a given path is relative to the current - * directory, relative to the current volume, or absolute. + * Determines whether a given path is relative to the current directory, + * relative to the current volume, or absolute. * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or @@ -428,18 +438,17 @@ Tcl_FSGetPathType(pathPtr) * * TclFSGetPathType -- * - * Determines whether a given path is relative to the current - * directory, relative to the current volume, or absolute. If the - * caller wishes to know which filesystem claimed the path (in the - * case for which the path is absolute), then a reference to a - * filesystem pointer can be passed in (but passing NULL is - * acceptable). + * Determines whether a given path is relative to the current directory, + * relative to the current volume, or absolute. If the caller wishes to + * know which filesystem claimed the path (in the case for which the path + * is absolute), then a reference to a filesystem pointer can be passed + * in (but passing NULL is acceptable). * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or - * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will - * be set if and only if it is non-NULL and the function's - * return value is TCL_PATH_ABSOLUTE. + * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and + * only if it is non-NULL and the function's return value is + * TCL_PATH_ABSOLUTE. * * Side effects: * None. @@ -454,18 +463,19 @@ TclFSGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr) int *driveNameLengthPtr; { if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { - return TclGetPathType(pathPtr, filesystemPtrPtr, + return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); } else { FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + if (fsPathPtr->cwdPtr != NULL) { if (PATHFLAGS(pathPtr) == 0) { return TCL_PATH_RELATIVE; } - return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, + return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, driveNameLengthPtr); } else { - return TclGetPathType(pathPtr, filesystemPtrPtr, + return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); } } @@ -476,29 +486,28 @@ TclFSGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr) * * TclPathPart * - * This procedure calculates the requested part of the given - * path, which can be: - * + * This function calculates the requested part of the given path, which + * can be: + * * - the directory above ('file dirname') * - the tail ('file tail') * - the extension ('file extension') * - the root ('file root') - * - * 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. - * - * Should look into integrating 'FileBasename' in tclFCmd.c into - * this function. - * + * + * 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. + * + * Should look into integrating 'FileBasename' in tclFCmd.c into this + * function. + * * Results: - * NULL if an error occurred, otherwise a Tcl_Obj owned by - * the caller (i.e. most likely with refCount 1). + * NULL if an error occurred, otherwise a Tcl_Obj owned by the caller + * (i.e. most likely with refCount 1). * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -506,109 +515,106 @@ 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 *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) + if (TclFSEpochOk(fsPathPtr->filesystemEpoch) && (PATHFLAGS(pathPtr) != 0)) { switch (portion) { - case TCL_PATH_DIRNAME: { - /* - * Check if the joined-on bit has any directory - * delimiters in it. If so, the 'dirname' would - * be a joining of the main part with the dirname - * of the joined-on bit. We could handle that - * special case here, but we don't, and instead - * just use the standardPath code. - */ - - CONST char *rest = TclGetString(fsPathPtr->normPathPtr); - if (strchr(rest, '/') != NULL) { - goto standardPath; - } - if (tclPlatform == TCL_PLATFORM_WINDOWS - && strchr(rest, '\\') != NULL) { - goto standardPath; - } + case TCL_PATH_DIRNAME: { + /* + * Check if the joined-on bit has any directory delimiters in + * it. If so, the 'dirname' would be a joining of the main + * part with the dirname of the joined-on bit. We could handle + * that special case here, but we don't, and instead just use + * the standardPath code. + */ - /* - * The joined-on path is simple, so we can just - * return here. - */ + CONST char *rest = TclGetString(fsPathPtr->normPathPtr); - Tcl_IncrRefCount(fsPathPtr->cwdPtr); - return fsPathPtr->cwdPtr; + if (strchr(rest, '/') != NULL) { + goto standardPath; + } + if (tclPlatform == TCL_PLATFORM_WINDOWS + && strchr(rest, '\\') != NULL) { + goto standardPath; } - case TCL_PATH_TAIL: { - /* - * Check if the joined-on bit has any directory - * delimiters in it. If so, the 'tail' would - * be only the part following the last delimiter. - * We could handle that special case here, but we - * don't, and instead just use the standardPath code. - */ - CONST char *rest = TclGetString(fsPathPtr->normPathPtr); - if (strchr(rest, '/') != NULL) { - goto standardPath; - } - if (tclPlatform == TCL_PLATFORM_WINDOWS - && strchr(rest, '\\') != NULL) { - goto standardPath; - } - Tcl_IncrRefCount(fsPathPtr->normPathPtr); - return fsPathPtr->normPathPtr; + /* + * The joined-on path is simple, so we can just return here. + */ + + Tcl_IncrRefCount(fsPathPtr->cwdPtr); + return fsPathPtr->cwdPtr; + } + case TCL_PATH_TAIL: { + /* + * Check if the joined-on bit has any directory delimiters in + * it. If so, the 'tail' would be only the part following the + * last delimiter. We could handle that special case here, but + * we don't, and instead just use the standardPath code. + */ + + CONST char *rest = TclGetString(fsPathPtr->normPathPtr); + + if (strchr(rest, '/') != NULL) { + goto standardPath; } - case TCL_PATH_EXTENSION: { - return GetExtension(fsPathPtr->normPathPtr); + if (tclPlatform == TCL_PLATFORM_WINDOWS + && strchr(rest, '\\') != NULL) { + goto standardPath; } - case TCL_PATH_ROOT: { - /* Unimplemented */ - CONST char *fileName, *extension; - int length; - fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, - &length); - extension = TclGetExtension(fileName); - if (extension == NULL) { - /* - * There is no extension so the root is the - * same as the path we were given. - */ - Tcl_IncrRefCount(pathPtr); - return pathPtr; - } else { - /* - * Duplicate the object we were given and - * then trim off the extension of the - * tail component of the path. - */ + Tcl_IncrRefCount(fsPathPtr->normPathPtr); + return fsPathPtr->normPathPtr; + } + case TCL_PATH_EXTENSION: + return GetExtension(fsPathPtr->normPathPtr); + case TCL_PATH_ROOT: { + /* Unimplemented */ + CONST char *fileName, *extension; + int length; + + fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, + &length); + extension = TclGetExtension(fileName); + if (extension == NULL) { + /* + * There is no extension so the root is the same as the + * path we were given. + */ - FsPath *fsDupPtr; - Tcl_Obj *root = Tcl_DuplicateObj(pathPtr); - - Tcl_IncrRefCount(root); - fsDupPtr = (FsPath*) PATHOBJ(root); - if (Tcl_IsShared(fsDupPtr->normPathPtr)) { - TclDecrRefCount(fsDupPtr->normPathPtr); - fsDupPtr->normPathPtr = - Tcl_NewStringObj(fileName, - (int)(length - strlen(extension))); - Tcl_IncrRefCount(fsDupPtr->normPathPtr); - } else { - Tcl_SetObjLength(fsDupPtr->normPathPtr, - (int)(length - strlen(extension))); - } - return root; + Tcl_IncrRefCount(pathPtr); + return pathPtr; + } else { + /* + * Duplicate the object we were given and then trim off + * the extension of the tail component of the path. + */ + + FsPath *fsDupPtr; + Tcl_Obj *root = Tcl_DuplicateObj(pathPtr); + + Tcl_IncrRefCount(root); + fsDupPtr = (FsPath*) PATHOBJ(root); + if (Tcl_IsShared(fsDupPtr->normPathPtr)) { + TclDecrRefCount(fsDupPtr->normPathPtr); + fsDupPtr->normPathPtr = Tcl_NewStringObj(fileName, + (int)(length - strlen(extension))); + Tcl_IncrRefCount(fsDupPtr->normPathPtr); + } else { + Tcl_SetObjLength(fsDupPtr->normPathPtr, + (int)(length - strlen(extension))); } + return root; } - default: { - /* We should never get here */ - Tcl_Panic("Bad portion to TclPathPart"); - /* For less clever compilers */ - return NULL; - } + } + default: + /* We should never get here */ + Tcl_Panic("Bad portion to TclPathPart"); + /* For less clever compilers */ + return NULL; } } else if (fsPathPtr->cwdPtr != NULL) { /* Relative path */ @@ -621,35 +627,34 @@ TclPathPart(interp, pathPtr, portion) int splitElements; Tcl_Obj *splitPtr; Tcl_Obj *resultPtr; - standardPath: - resultPtr = NULL; - if (portion == TCL_PATH_EXTENSION) { + standardPath: + resultPtr = NULL; + if (portion == TCL_PATH_EXTENSION) { return GetExtension(pathPtr); - } else if (portion == TCL_PATH_ROOT) { + } else if (portion == TCL_PATH_ROOT) { int length; CONST char *fileName, *extension; - + fileName = Tcl_GetStringFromObj(pathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { Tcl_IncrRefCount(pathPtr); return pathPtr; } else { - Tcl_Obj *root = Tcl_NewStringObj(fileName, + Tcl_Obj *root = Tcl_NewStringObj(fileName, (int) (length - strlen(extension))); Tcl_IncrRefCount(root); return root; } - } - - /* - * 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 actual full path name, if we - * had just a single component. - */ + } + + /* + * 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 + * actual full path name, if we had just a single component. + */ splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); Tcl_IncrRefCount(splitPtr); @@ -666,8 +671,8 @@ TclPathPart(interp, pathPtr, portion) } if (portion == TCL_PATH_TAIL) { /* - * Return the last component, unless it is the only component, - * and it is the root of an absolute path. + * Return the last component, unless it is the only component, and + * it is the root of an absolute path. */ if ((splitElements > 0) && ((splitElements > 1) || @@ -678,14 +683,14 @@ TclPathPart(interp, pathPtr, portion) } } else { /* - * Return all but the last component. If there is only one + * Return all but the last component. If there is only one * component, return it if the path was non-relative, otherwise * return the current directory. */ if (splitElements > 1) { resultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1); - } else if (splitElements == 0 || + } else if (splitElements == 0 || (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) { resultPtr = Tcl_NewStringObj(".", 1); } else { @@ -699,16 +704,16 @@ TclPathPart(interp, pathPtr, portion) } /* - * Simple helper function + * Simple helper function */ static Tcl_Obj* -GetExtension(pathPtr) +GetExtension(pathPtr) Tcl_Obj *pathPtr; { CONST char *tail, *extension; Tcl_Obj *ret; - + tail = TclGetString(pathPtr); extension = TclGetExtension(tail); if (extension == NULL) { @@ -725,29 +730,28 @@ GetExtension(pathPtr) * * Tcl_FSJoinPath -- * - * This function takes the given Tcl_Obj, which should be a valid - * list, and returns the path object given by considering the - * first 'elements' elements as valid path segments (each path - * segment may be a complete path, a partial path or just a single - * possible directory or file name). If any path segment is - * actually an absolute path, then all prior path segments are - * discarded. - * - * If elements < 0, we use the entire list that was given. - * - * It is possible that the returned object is actually an element - * of the given list, so the caller should be careful to store a - * refCount to it before freeing the list. - * + * This function takes the given Tcl_Obj, which should be a valid list, + * and returns the path object given by considering the first 'elements' + * elements as valid path segments (each path segment may be a complete + * path, a partial path or just a single possible directory or file + * name). If any path segment is actually an absolute path, then all + * prior path segments are discarded. + * + * If elements < 0, we use the entire list that was given. + * + * It is possible that the returned object is actually an element of the + * given list, so the caller should be careful to store a refCount to it + * before freeing the list. + * * Results: - * Returns object with refCount of zero, (or if non-zero, it has - * references elsewhere in Tcl). Either way, the caller must - * increment its refCount before use. Note that in the case where - * the caller has asked to join zero elements of the list, the - * return value will be an empty-string Tcl_Obj. - * - * If the given listObj was invalid, then the calling routine has - * a bug, and this function will just return NULL. + * Returns object with refCount of zero, (or if non-zero, it has + * references elsewhere in Tcl). Either way, the caller must increment + * its refCount before use. Note that in the case where the caller has + * asked to join zero elements of the list, the return value will be an + * empty-string Tcl_Obj. + * + * If the given listObj was invalid, then the calling routine has a bug, + * and this function will just return NULL. * * Side effects: * None. @@ -755,36 +759,43 @@ GetExtension(pathPtr) *--------------------------------------------------------------------------- */ -Tcl_Obj* +Tcl_Obj* Tcl_FSJoinPath(listObj, elements) - Tcl_Obj *listObj; /* Path elements to join, may have refCount 0 */ - int elements; /* Number of elements to use (-1 = all) */ + Tcl_Obj *listObj; /* Path elements to join, may have a zero + * reference count. */ + int elements; /* Number of elements to use (-1 = all) */ { Tcl_Obj *res; int i; Tcl_Filesystem *fsPtr = NULL; - + if (elements < 0) { if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) { return NULL; } } else { - /* Just make sure it is a valid list */ + /* + * Just make sure it is a valid list. + */ + int listTest; + if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) { return NULL; } - /* - * Correct this if it is too large, otherwise we will - * waste our time joining null elements to the path + + /* + * Correct this if it is too large, otherwise we will waste our time + * joining null elements to the path. */ + if (elements > listTest) { elements = listTest; } } - + res = NULL; - + for (i = 0; i < elements; i++) { Tcl_Obj *elt; int driveNameLength; @@ -794,23 +805,23 @@ Tcl_FSJoinPath(listObj, elements) int length; char *ptr; Tcl_Obj *driveName = NULL; - + Tcl_ListObjIndex(NULL, listObj, i, &elt); - - /* - * This is a special case where we can be much more - * efficient, where we are joining a single relative path - * onto an object that is already of path type. The - * 'TclNewFSPathObj' call below creates an object which - * can be normalized more efficiently. Currently we only - * use the special case when we have exactly two elements, - * but we could expand that in the future. + + /* + * This is a special case where we can be much more efficient, where + * we are joining a single relative path onto an object that is + * already of path type. The 'TclNewFSPathObj' call below creates an + * object which can be normalized more efficiently. Currently we only + * use the special case when we have exactly two elements, but we + * could expand that in the future. */ if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType) && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) { Tcl_Obj *tail; Tcl_PathType type; + Tcl_ListObjIndex(NULL, listObj, i+1, &tail); type = TclGetPathType(tail, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { @@ -819,36 +830,37 @@ Tcl_FSJoinPath(listObj, elements) str = Tcl_GetStringFromObj(tail, &len); if (len == 0) { - /* - * This happens if we try to handle the root volume - * '/'. There's no need to return a special path - * object, when the base itself is just fine! + /* + * This happens if we try to handle the root volume '/'. + * There's no need to return a special path object, when + * the base itself is just fine! */ + if (res != NULL) { TclDecrRefCount(res); } return elt; } - /* - * If it doesn't begin with '.' and is a unix - * path or it a 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 would not have forward slashes only, - * and this would therefore contradict our 'file join' - * documentation). + /* + * 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 + * would not have forward slashes only, and this would + * therefore contradict our 'file join' documentation). */ - if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) + if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) || (strchr(str, '\\') == NULL))) { - /* - * Finally, on Windows, 'file join' is defined to - * convert all backslashes to forward slashes, - * so the base part cannot have backslashes either. + /* + * Finally, on Windows, 'file join' is defined to convert + * all backslashes to forward slashes, so the base part + * cannot have backslashes either. */ + if ((tclPlatform != TCL_PLATFORM_WINDOWS) - || (strchr(Tcl_GetString(elt), '\\') == NULL)) { + || (strchr(Tcl_GetString(elt), '\\') == NULL)) { if (res != NULL) { TclDecrRefCount(res); } @@ -856,28 +868,26 @@ Tcl_FSJoinPath(listObj, elements) } } - /* - * Otherwise we don't have an easy join, and - * we must let the more general code below handle - * things + /* + * Otherwise we don't have an easy join, and we must let the + * more general code below handle things */ + } else if (tclPlatform == TCL_PLATFORM_UNIX) { + if (res != NULL) { + TclDecrRefCount(res); + } + return tail; } else { - if (tclPlatform == TCL_PLATFORM_UNIX) { - if (res != NULL) { - TclDecrRefCount(res); - } - return tail; - } else { - CONST char *str; - int len; - str = Tcl_GetStringFromObj(tail, &len); - if (tclPlatform == TCL_PLATFORM_WINDOWS) { - if (strchr(str, '\\') == NULL) { - if (res != NULL) { - TclDecrRefCount(res); - } - return tail; + CONST char *str; + int len; + + str = Tcl_GetStringFromObj(tail, &len); + if (tclPlatform == TCL_PLATFORM_WINDOWS) { + if (strchr(str, '\\') == NULL) { + if (res != NULL) { + TclDecrRefCount(res); } + return tail; } } } @@ -885,92 +895,96 @@ Tcl_FSJoinPath(listObj, elements) strElt = Tcl_GetStringFromObj(elt, &strEltLen); type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { - /* Zero out the current result */ + /* + * Zero out the current result. + */ + if (res != NULL) { TclDecrRefCount(res); } if (driveName != NULL) { /* - * We've been given a separate drive-name object, - * because the prefix in 'elt' is not in a suitable - * format for us (e.g. it may contain irrelevant - * multiple separators, like C://///foo). + * We've been given a separate drive-name object, because the + * prefix in 'elt' is not in a suitable format for us (e.g. it + * may contain irrelevant multiple separators, like + * C://///foo). */ res = Tcl_DuplicateObj(driveName); TclDecrRefCount(driveName); - /* - * Do not set driveName to NULL, because we will check - * its value below (but we won't access the contents, - * since those have been cleaned-up). + /* + * Do not set driveName to NULL, because we will check its + * value below (but we won't access the contents, since those + * have been cleaned-up). */ } else { res = Tcl_NewStringObj(strElt, driveNameLength); } strElt += driveNameLength; } - - /* - * 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 procedure. + + /* + * 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 + * function. */ - if ((driveName == NULL) && (i == (elements - 1)) + 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 is already in a suitable form. + /* + * It's the last path segment. Perform a quick check if the path + * is already in a suitable form. */ - + if (tclPlatform == TCL_PLATFORM_WINDOWS) { if (strchr(strElt, '\\') != NULL) { goto noQuickReturn; } } - ptr = strElt; - while (*ptr != '\0') { - if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) { - /* - * We have a repeated file separator, which - * means the path is not in normalized form - */ - goto noQuickReturn; - } - ptr++; - } - if (res != NULL) { + ptr = strElt; + while (*ptr != '\0') { + if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) { + /* + * We have a repeated file separator, which means the path + * is not in normalized form + */ + goto noQuickReturn; + } + ptr++; + } + if (res != NULL) { TclDecrRefCount(res); } - /* - * This element is just what we want to return already - - * no further manipulation is requred. - */ - return elt; + + /* + * This element is just what we want to return already - no + * further manipulation is requred. + */ + + return elt; } - /* - * The path element was not of a suitable form to be - * returned as is. We need to perform a more complex - * operation here. - */ + /* + * The path element was not of a suitable form to be returned as is. + * We need to perform a more complex operation here. + */ + + noQuickReturn: - noQuickReturn: - if (res == NULL) { res = Tcl_NewObj(); ptr = Tcl_GetStringFromObj(res, &length); } else { ptr = Tcl_GetStringFromObj(res, &length); } - - /* - * Strip off any './' before a tilde, unless this is the - * beginning of the path. + + /* + * Strip off any './' before a tilde, unless this is the beginning of + * the path. */ if (length > 0 && strEltLen > 0 && (strElt[0] == '.') && @@ -978,23 +992,22 @@ Tcl_FSJoinPath(listObj, elements) strElt += 2; } - /* - * A NULL value for fsPtr at this stage basically means - * we're trying to join a relative path onto something - * which is also relative (or empty). There's nothing - * particularly wrong with that. + /* + * A NULL value for fsPtr at this stage basically means we're trying + * to join a relative path onto something which is also relative (or + * empty). There's nothing particularly wrong with that. */ if (*strElt == '\0') { continue; } - + if (fsPtr == &tclNativeFilesystem || fsPtr == NULL) { TclpNativeJoinPath(res, strElt); } else { char separator = '/'; int needsSep = 0; - + if (fsPtr->filesystemSeparatorProc != NULL) { Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res); if (sep != NULL) { @@ -1029,7 +1042,7 @@ Tcl_FSJoinPath(listObj, elements) } } if (res == NULL) { - res = Tcl_NewObj(); + res = Tcl_NewObj(); } return res; } @@ -1039,17 +1052,15 @@ Tcl_FSJoinPath(listObj, elements) * * Tcl_FSConvertToPathType -- * - * This function tries to convert the given Tcl_Obj to a valid - * Tcl path type, taking account of the fact that the cwd may - * have changed even if this object is already supposedly of - * the correct type. - * - * The filename may begin with "~" (to indicate current user's - * home directory) or "~<user>" (to indicate any user's home - * directory). + * This function tries to convert the given Tcl_Obj to a valid Tcl path + * type, taking account of the fact that the cwd may have changed even if + * this object is already supposedly of the correct type. + * + * The filename may begin with "~" (to indicate current user's home + * directory) or "~<user>" (to indicate any user's home directory). * * Results: - * Standard Tcl error code. + * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. @@ -1057,21 +1068,21 @@ Tcl_FSJoinPath(listObj, elements) *--------------------------------------------------------------------------- */ -int +int Tcl_FSConvertToPathType(interp, pathPtr) - Tcl_Interp *interp; /* Interpreter in which to store error - * message (if necessary). */ - Tcl_Obj *pathPtr; /* Object to convert to a valid, current - * path type. */ + Tcl_Interp *interp; /* Interpreter in which to store error message + * (if necessary). */ + 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 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 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 path. + /* + * 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 + * 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 + * 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 + * path. */ if (pathPtr->typePtr == &tclFsPathType) { @@ -1085,9 +1096,9 @@ Tcl_FSConvertToPathType(interp, pathPtr) return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); } return TCL_OK; - /* + /* * We used to have more complex code here: - * + * * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) { * return TCL_OK; * } else { @@ -1102,7 +1113,7 @@ Tcl_FSConvertToPathType(interp, pathPtr) * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); * } * } - * + * * But we no longer believe this is necessary. */ } else { @@ -1110,7 +1121,7 @@ Tcl_FSConvertToPathType(interp, pathPtr) } } -/* +/* * Helper function for normalization. */ @@ -1119,23 +1130,21 @@ IsSeparatorOrNull(ch) int ch; { if (ch == 0) { - return 1; + return 1; } switch (tclPlatform) { - case TCL_PLATFORM_UNIX: { - return (ch == '/' ? 1 : 0); - } - case TCL_PLATFORM_WINDOWS: { - return ((ch == '/' || ch == '\\') ? 1 : 0); - } + case TCL_PLATFORM_UNIX: + return (ch == '/' ? 1 : 0); + case TCL_PLATFORM_WINDOWS: + return ((ch == '/' || ch == '\\') ? 1 : 0); } return 0; } -/* - * 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. +/* + * 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 @@ -1171,17 +1180,16 @@ FindSplitPos(path, separator) * * TclNewFSPathObj -- * - * Creates a path object whose string representation is '[file join - * dirPtr addStrRep]', but does so in a way that allows for more - * efficient creation and caching of normalized paths, and more - * efficient 'file dirname', 'file tail', etc. - * + * Creates a path object whose string representation is '[file join + * dirPtr addStrRep]', but does so in a way that allows for more + * efficient creation and caching of normalized paths, and more efficient + * '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. + * The new Tcl object, with refCount zero. * * Side effects: * Memory is allocated. 'dirPtr' gets an additional refCount. @@ -1195,13 +1203,16 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) FsPath *fsPathPtr; Tcl_Obj *pathPtr; ThreadSpecificData *tsdPtr; - + tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - + pathPtr = Tcl_NewObj(); fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); - - /* Setup the path */ + + /* + * Set up the path. + */ + fsPathPtr->translatedPathPtr = NULL; fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len); Tcl_IncrRefCount(fsPathPtr->normPathPtr); @@ -1225,23 +1236,22 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) * * TclFSMakePathRelative -- * - * Only for internal use. - * - * 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 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. - * + * Only for internal use. + * + * 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 + * 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. + * NULL on error, otherwise a valid object, typically with refCount of + * zero, which it is assumed the caller will increment. * * Side effects: * The old representation may be freed, and new memory allocated. @@ -1258,13 +1268,17 @@ TclFSMakePathRelative(interp, pathPtr, cwdPtr) int cwdLen, len; CONST char *tempStr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - + if (pathPtr->typePtr == &tclFsPathType) { FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); - if (PATHFLAGS(pathPtr) != 0 + if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { pathPtr = fsPathPtr->normPathPtr; - /* Free old representation */ + + /* + * Free old representation. + */ + if (pathPtr->typePtr != NULL) { if (pathPtr->bytes == NULL) { if (pathPtr->typePtr->updateStringProc == NULL) { @@ -1279,20 +1293,26 @@ TclFSMakePathRelative(interp, pathPtr, cwdPtr) } TclFreeIntRep(pathPtr); } - /* Now pathPtr is a string object */ - + + /* + * 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'. + /* + * 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 */ + /* + * Circular reference, by design. + */ + fsPathPtr->translatedPathPtr = pathPtr; fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = cwdPtr; @@ -1309,38 +1329,36 @@ TclFSMakePathRelative(interp, pathPtr, cwdPtr) } } - /* + /* * We know the cwd is a normalised object which does not end in a - * directory delimiter, unless the cwd is the name of a volume, in - * which case it will end in a delimiter! We handle this - * situation here. A better test than the '!= sep' might be to - * simply check if 'cwd' is a root volume. - * - * Note that if we get this wrong, we will strip off either too - * much or too little below, leading to wrong answers returned by - * glob. + * directory delimiter, unless the cwd is the name of a volume, in which + * case it will end in a delimiter! We handle this situation here. A + * better test than the '!= sep' might be to simply check if 'cwd' is a + * root volume. + * + * Note that if we get this wrong, we will strip off either too much or + * too little below, leading to wrong answers returned by glob. */ tempStr = Tcl_GetStringFromObj(cwdPtr, &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. + /* + * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the + * Windows special case? Perhaps we should just check if cwd is a root + * volume. */ switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - if (tempStr[cwdLen-1] != '/') { - cwdLen++; - } - break; - case TCL_PLATFORM_WINDOWS: - if (tempStr[cwdLen-1] != '/' - && tempStr[cwdLen-1] != '\\') { - cwdLen++; - } - break; + case TCL_PLATFORM_UNIX: + if (tempStr[cwdLen-1] != '/') { + cwdLen++; + } + break; + case TCL_PLATFORM_WINDOWS: + if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') { + cwdLen++; + } + break; } tempStr = Tcl_GetStringFromObj(pathPtr, &len); @@ -1352,11 +1370,11 @@ TclFSMakePathRelative(interp, pathPtr, cwdPtr) * * TclFSMakePathFromNormalized -- * - * Like SetFsPathFromAny, but assumes the given object is an - * absolute normalized path. Only for internal use. - * + * Like SetFsPathFromAny, but assumes the given object is an absolute + * normalized path. Only for internal use. + * * Results: - * Standard Tcl error code. + * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. @@ -1377,15 +1395,18 @@ TclFSMakePathFromNormalized(interp, pathPtr, nativeRep) if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; } - - /* Free old representation */ + + /* + * 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); + "string representation", (char *) NULL); } return TCL_ERROR; } @@ -1395,9 +1416,17 @@ TclFSMakePathFromNormalized(interp, pathPtr, nativeRep) } fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); - /* It's a pure normalized absolute path */ + + /* + * It's a pure normalized absolute path. + */ + fsPathPtr->translatedPathPtr = NULL; - /* Circular reference by design */ + + /* + * Circular reference by design. + */ + fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = nativeRep; @@ -1416,20 +1445,19 @@ TclFSMakePathFromNormalized(interp, pathPtr, nativeRep) * * Tcl_FSNewNativePath -- * - * This function performs the something like the reverse of the - * usual obj->path->nativerep conversions. If some code retrieves - * a path in native form (from, e.g. readlink or a native dialog), - * and that path is to be used at the Tcl level, then calling - * this function is an efficient way of creating the appropriate - * path object type. - * - * Any memory which is allocated for 'clientData' should be retained - * until clientData is passed to the filesystem's freeInternalRepProc - * when it can be freed. The built in platform-specific filesystems - * use 'ckalloc' to allocate clientData, and ckfree to free it. + * This function performs the something like the reverse of the usual + * obj->path->nativerep conversions. If some code retrieves a path in + * native form (from, e.g. readlink or a native dialog), and that path is + * to be used at the Tcl level, then calling this function is an + * efficient way of creating the appropriate path object type. + * + * Any memory which is allocated for 'clientData' should be retained + * until clientData is passed to the filesystem's freeInternalRepProc + * when it can be freed. The built in platform-specific filesystems use + * 'ckalloc' to allocate clientData, and ckfree to free it. * * Results: - * NULL or a valid path object pointer, with refCount zero. + * NULL or a valid path object pointer, with refCount zero. * * Side effects: * New memory may be allocated. @@ -1447,17 +1475,18 @@ Tcl_FSNewNativePath(fromFilesystem, clientData) FilesystemRecord *fsFromPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - + pathPtr = TclFSInternalToNormalized(fromFilesystem, clientData, - &fsFromPtr); + &fsFromPtr); if (pathPtr == NULL) { return NULL; } - - /* - * Free old representation; shouldn't normally be any, - * but best to be safe. + + /* + * Free old representation; shouldn't normally be any, but best to be + * safe. */ + if (pathPtr->typePtr != NULL) { if (pathPtr->bytes == NULL) { if (pathPtr->typePtr->updateStringProc == NULL) { @@ -1467,17 +1496,21 @@ Tcl_FSNewNativePath(fromFilesystem, clientData) } TclFreeIntRep(pathPtr); } - - fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); + + fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; - /* Circular reference, by design */ + + /* + * Circular reference, by design. + */ + fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; fsPathPtr->fsRecPtr = fsFromPtr; fsPathPtr->fsRecPtr->fileRefCount++; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; PATHOBJ(pathPtr) = (VOID *) fsPathPtr; PATHFLAGS(pathPtr) = 0; @@ -1491,14 +1524,13 @@ Tcl_FSNewNativePath(fromFilesystem, clientData) * * Tcl_FSGetTranslatedPath -- * - * This function attempts to extract the translated path - * from the given Tcl_Obj. If the translation succeeds (i.e. the - * object is a valid path), then it is returned. Otherwise NULL - * will be returned, and an error message may be left in the - * interpreter (if it is non-NULL) + * This function attempts to extract the translated path from the given + * Tcl_Obj. If the translation succeeds (i.e. the object is a valid + * path), then it is returned. Otherwise NULL will be returned, and an + * error message may be left in the interpreter (if it is non-NULL) * * Results: - * NULL or a valid Tcl_Obj pointer. + * NULL or a valid Tcl_Obj pointer. * * Side effects: * Only those of 'Tcl_FSConvertToPathType' @@ -1506,7 +1538,7 @@ Tcl_FSNewNativePath(fromFilesystem, clientData) *--------------------------------------------------------------------------- */ -Tcl_Obj* +Tcl_Obj* Tcl_FSGetTranslatedPath(interp, pathPtr) Tcl_Interp *interp; Tcl_Obj* pathPtr; @@ -1522,16 +1554,19 @@ Tcl_FSGetTranslatedPath(interp, pathPtr) if (PATHFLAGS(pathPtr) != 0) { retObj = Tcl_FSGetNormalizedPath(interp, pathPtr); } 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. + /* + * 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 { - /* It is an ordinary path object */ + /* + * It is an ordinary path object. + */ + retObj = srcFsPathPtr->translatedPathPtr; } @@ -1544,14 +1579,13 @@ Tcl_FSGetTranslatedPath(interp, pathPtr) * * Tcl_FSGetTranslatedStringPath -- * - * This function attempts to extract the translated path - * from the given Tcl_Obj. If the translation succeeds (i.e. the - * object is a valid path), then the path is returned. Otherwise NULL - * will be returned, and an error message may be left in the - * interpreter (if it is non-NULL) + * This function attempts to extract the translated path from the given + * Tcl_Obj. If the translation succeeds (i.e. the object is a valid + * path), then the path is returned. Otherwise NULL will be returned, and + * an error message may be left in the interpreter (if it is non-NULL) * * Results: - * NULL or a valid string. + * NULL or a valid string. * * Side effects: * Only those of 'Tcl_FSConvertToPathType' @@ -1569,6 +1603,7 @@ Tcl_FSGetTranslatedStringPath(interp, pathPtr) if (transPtr != NULL) { int len; CONST char *result, *orig; + orig = Tcl_GetStringFromObj(transPtr, &len); result = (char*) ckalloc((unsigned)(len+1)); memcpy((VOID*) result, (VOID*) orig, (size_t) (len+1)); @@ -1584,21 +1619,21 @@ Tcl_FSGetTranslatedStringPath(interp, pathPtr) * * Tcl_FSGetNormalizedPath -- * - * This important function attempts to extract from the given Tcl_Obj - * a unique normalised path representation, whose string value can - * be used as a unique identifier for the file. + * This important function attempts to extract from the given Tcl_Obj a + * unique normalised path representation, whose string value can be used + * as a unique identifier for the file. * * Results: - * NULL or a valid path object pointer. + * NULL or a valid path object pointer. * * Side effects: - * New memory may be allocated. The Tcl 'errno' may be modified - * in the process of trying to examine various path possibilities. + * New memory may be allocated. The Tcl 'errno' may be modified in the + * process of trying to examine various path possibilities. * *--------------------------------------------------------------------------- */ -Tcl_Obj* +Tcl_Obj* Tcl_FSGetNormalizedPath(interp, pathPtr) Tcl_Interp *interp; Tcl_Obj* pathPtr; @@ -1611,9 +1646,9 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) fsPathPtr = (FsPath*) PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0) { - /* - * This is a special path object which is the result of - * something like 'file join' + /* + * This is a special path object which is the result of something like + * 'file join' */ Tcl_Obj *dir, *copy; @@ -1621,7 +1656,7 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) int pathType; CONST char *cwdStr; ClientData clientData = NULL; - + pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); if (dir == NULL) { @@ -1637,60 +1672,61 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) /* * We now own a reference on both 'dir' and '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. + /* + * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about + * the Windows special case? Perhaps we should just check if cwd is a + * root volume. We should never get cwdLen == 0 in this code path. */ switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - if (cwdStr[cwdLen-1] != '/') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; - case TCL_PLATFORM_WINDOWS: - if (cwdStr[cwdLen-1] != '/' - && cwdStr[cwdLen-1] != '\\') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; + 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); - /* - * 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. + /* + * 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. */ - TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); /* * 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); - + fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr; Tcl_IncrRefCount(fsPathPtr->cwdPtr); - + TclDecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; - /* That's our reference to copy used */ + + /* + * That's our reference to copy used. + */ + TclDecrRefCount(dir); TclDecrRefCount(origDir); } else { @@ -1698,7 +1734,11 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) fsPathPtr->cwdPtr = NULL; TclDecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; - /* That's our reference to copy used */ + + /* + * That's our reference to copy used. + */ + TclDecrRefCount(dir); } if (clientData != NULL) { @@ -1708,7 +1748,7 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) } /* - * Ensure cwd hasn't changed + * Ensure cwd hasn't changed. */ if (fsPathPtr->cwdPtr != NULL) { @@ -1727,41 +1767,40 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) 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. + /* + * Should we perhaps use 'Tcl_FSPathSeparator'? But then what + * about the Windows special case? Perhaps we should just check + * if cwd is a root volume. We should never get cwdLen == 0 in + * this code path. */ switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - if (cwdStr[cwdLen-1] != '/') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; - case TCL_PLATFORM_WINDOWS: - if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; + 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); - /* - * Normalize the combined string, but only starting after - * the end of the previously normalized 'dir'. This should - * be much faster! + /* + * 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, + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); fsPathPtr->normPathPtr = copy; if (clientData != NULL) { @@ -1773,30 +1812,28 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) ClientData clientData = NULL; Tcl_Obj *useThisCwd = NULL; - /* - * Since normPathPtr is NULL, but this is a valid path - * object, we know that the translatedPathPtr cannot be NULL. + /* + * Since normPathPtr is NULL, but this is a valid path object, we know + * that the translatedPathPtr cannot be NULL. */ Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr; CONST char *path = TclGetString(absolutePath); - /* + /* * We have to be a little bit careful here to avoid infinite loops - * we're asking Tcl_FSGetPathType to return the path's type, but - * that call can actually result in a lot of other filesystem - * action, which might loop back through here. + * we're asking Tcl_FSGetPathType to return the path's type, but that + * call can actually result in a lot of other filesystem action, which + * might loop back through here. */ if (path[0] != '\0') { - /* - * 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 has a bit of a contradiction in - * that '~' paths are defined as 'absolute', but in - * reality can be just about anything, depending on - * how env(HOME) is set. + * 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 + * has a bit of a contradiction in that '~' paths are defined as + * 'absolute', but in reality can be just about anything, + * depending on how env(HOME) is set. */ Tcl_PathType type = Tcl_FSGetPathType(absolutePath); @@ -1810,12 +1847,17 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); Tcl_IncrRefCount(absolutePath); - /* We have a refCount on the cwd */ + + /* + * We have a refCount on the cwd. + */ #ifdef __WIN32__ } else if (type == TCL_PATH_VOLUME_RELATIVE) { - /* Only Windows has volume-relative paths */ - absolutePath = TclWinVolumeRelativeNormalize(interp, path, - &useThisCwd); + /* + * Only Windows has volume-relative paths. + */ + absolutePath = TclWinVolumeRelativeNormalize(interp, + path, &useThisCwd); if (absolutePath == NULL) { return NULL; } @@ -1824,44 +1866,43 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) } /* - * Already has refCount incremented + * Already has refCount incremented. */ fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, - absolutePath, + absolutePath, (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); if (0 && (clientData != NULL)) { - fsPathPtr->nativePathPtr = + fsPathPtr->nativePathPtr = (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData); } - /* - * Check if path is pure normalized (this can only be the case - * if it is an absolute path). + /* + * 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))) { - /* - * The path was already normalized. - * Get rid of the duplicate. + /* + * The path was already normalized. Get rid of the duplicate. */ TclDecrRefCount(fsPathPtr->normPathPtr); - /* - * We do *not* increment the refCount for - * this circular reference + /* + * We do *not* increment the refCount for this circular + * reference. */ fsPathPtr->normPathPtr = pathPtr; } } else { - /* - * 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. + /* + * 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); @@ -1877,16 +1918,16 @@ 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 filesystem, we return NULL. - * - * If the internal representation is currently NULL, we attempt - * to generate it, by calling the filesystem's - * 'Tcl_FSCreateInternalRepProc'. + * 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. + * + * If the internal representation is currently NULL, we attempt to + * generate it, by calling the filesystem's + * 'Tcl_FSCreateInternalRepProc'. * * Results: - * NULL or a valid internal representation. + * NULL or a valid internal representation. * * Side effects: * An attempt may be made to convert the object. @@ -1894,52 +1935,49 @@ Tcl_FSGetNormalizedPath(interp, pathPtr) *--------------------------------------------------------------------------- */ -ClientData +ClientData Tcl_FSGetInternalRep(pathPtr, fsPtr) Tcl_Obj* pathPtr; Tcl_Filesystem *fsPtr; { FsPath* srcFsPathPtr; - + if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { return NULL; } srcFsPathPtr = (FsPath*) 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. - * - * 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. + * 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) { - /* - * 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. + /* + * 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). + + /* + * 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 = (FsPath*) PATHOBJ(pathPtr); @@ -1948,12 +1986,11 @@ 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. + /* + * There is still one possibility we should consider; if the file belongs + * to a different filesystem, perhaps it is actually linked through to a + * file in our own filesystem which we do care about. The way we can + * check for this is we ask what filesystem this path belongs to. */ if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) { @@ -1983,13 +2020,12 @@ Tcl_FSGetInternalRep(pathPtr, fsPtr) * * 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. + * This will ensure the pathPtr is up to date and can be converted into a + * "path" type, and that we are able to generate a complete normalized + * path which is used to determine the filesystem match. * * Results: - * Standard Tcl return code. + * Standard Tcl return code. * * Side effects: * An attempt may be made to convert the object. @@ -1997,7 +2033,7 @@ Tcl_FSGetInternalRep(pathPtr, fsPtr) *--------------------------------------------------------------------------- */ -int +int TclFSEnsureEpochOk(pathPtr, fsPtrPtr) Tcl_Obj* pathPtr; Tcl_Filesystem **fsPtrPtr; @@ -2010,15 +2046,14 @@ TclFSEnsureEpochOk(pathPtr, fsPtrPtr) srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); - /* - * Check if the filesystem has changed in some way since - * this object's internal representation was calculated. + /* + * 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 + /* + * We have to discard the stale representation and recalculate it. */ if (pathPtr->bytes == NULL) { @@ -2033,7 +2068,7 @@ TclFSEnsureEpochOk(pathPtr, fsPtrPtr) } /* - * Check whether the object is already assigned to a fs + * Check whether the object is already assigned to a fs. */ if (srcFsPathPtr->fsRecPtr != NULL) { @@ -2058,26 +2093,29 @@ TclFSEnsureEpochOk(pathPtr, fsPtrPtr) *--------------------------------------------------------------------------- */ -void -TclFSSetPathDetails(pathPtr, fsRecPtr, clientData) +void +TclFSSetPathDetails(pathPtr, fsRecPtr, clientData) Tcl_Obj *pathPtr; FilesystemRecord *fsRecPtr; ClientData clientData; { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); FsPath* srcFsPathPtr; - - /* Make sure pathPtr is of the correct type */ + + /* + * Make sure pathPtr is of the correct type. + */ + if (pathPtr->typePtr != &tclFsPathType) { if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return; } } - + srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); srcFsPathPtr->fsRecPtr = fsRecPtr; srcFsPathPtr->nativePathPtr = clientData; - srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; fsRecPtr->fileRefCount++; } @@ -2086,11 +2124,11 @@ TclFSSetPathDetails(pathPtr, fsRecPtr, clientData) * * Tcl_FSEqualPaths -- * - * This function tests whether the two paths given are equal path - * objects. If either or both is NULL, 0 is always returned. + * This function tests whether the two paths given are equal path + * objects. If either or both is NULL, 0 is always returned. * * Results: - * 1 or 0. + * 1 or 0. * * Side effects: * None. @@ -2098,7 +2136,7 @@ TclFSSetPathDetails(pathPtr, fsRecPtr, clientData) *--------------------------------------------------------------------------- */ -int +int Tcl_FSEqualPaths(firstPtr, secondPtr) Tcl_Obj* firstPtr; Tcl_Obj* secondPtr; @@ -2119,9 +2157,9 @@ Tcl_FSEqualPaths(firstPtr, secondPtr) return 1; } - /* - * Try the most thorough, correct method of comparing fully - * normalized paths + /* + * Try the most thorough, correct method of comparing fully normalized + * paths. */ tempErrno = Tcl_GetErrno(); @@ -2133,7 +2171,7 @@ Tcl_FSEqualPaths(firstPtr, secondPtr) return 0; } - firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); + firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0); } @@ -2143,15 +2181,14 @@ Tcl_FSEqualPaths(firstPtr, secondPtr) * * SetFsPathFromAny -- * - * This function tries to convert the given Tcl_Obj to a valid - * Tcl path type. - * - * The filename may begin with "~" (to indicate current user's - * home directory) or "~<user>" (to indicate any user's home - * directory). + * This function tries to convert the given Tcl_Obj to a valid Tcl path + * type. + * + * The filename may begin with "~" (to indicate current user's home + * directory) or "~<user>" (to indicate any user's home directory). * * Results: - * Standard Tcl error code. + * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. @@ -2169,25 +2206,23 @@ SetFsPathFromAny(interp, pathPtr) Tcl_Obj *transPtr; char *name; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - + if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; } - - /* - * First step is to translate the filename. This is similar to - * Tcl_TranslateFilename, but shouldn't convert everything to - * windows backslashes on that platform. The current - * implementation of this piece is a slightly optimised version - * of the various Tilde/Split/Join stuff to avoid multiple - * split/join operations. - * + + /* + * First step is to translate the filename. This is similar to + * Tcl_TranslateFilename, but shouldn't convert everything to windows + * backslashes on that platform. The current implementation of this piece + * is a slightly optimised version of the various Tilde/Split/Join stuff + * to avoid multiple split/join operations. + * * We remove any trailing directory separator. - * - * However, the split/join routines are quite complex, and - * one has to make sure not to break anything on Unix or Win - * (fCmd.test, fileName.test and cmdAH.test exercise - * most of the code). + * + * However, the split/join routines are quite complex, and one has to make + * sure not to break anything on Unix or Win (fCmd.test, fileName.test and + * cmdAH.test exercise most of the code). */ name = Tcl_GetStringFromObj(pathPtr, &len); @@ -2201,7 +2236,7 @@ SetFsPathFromAny(interp, pathPtr) Tcl_DString temp; int split; char separator='/'; - + split = FindSplitPos(name, separator); if (split != len) { /* We have multiple pieces '~user/foo/bar...' */ @@ -2209,7 +2244,7 @@ SetFsPathFromAny(interp, pathPtr) } /* - * Do some tilde substitution + * Do some tilde substitution. */ if (name[1] == '\0') { @@ -2223,7 +2258,7 @@ SetFsPathFromAny(interp, pathPtr) if (split != len) { name[split] = separator; } - + dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { @@ -2242,11 +2277,11 @@ SetFsPathFromAny(interp, pathPtr) */ Tcl_DStringInit(&temp); - if (TclpGetUserHome(name+1, &temp) == NULL) { + if (TclpGetUserHome(name+1, &temp) == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "user \"", (name+1), - "\" doesn't exist", (char *) NULL); + Tcl_AppendResult(interp, "user \"", (name+1), + "\" doesn't exist", (char *) NULL); } Tcl_DStringFree(&temp); if (split != len) { @@ -2258,37 +2293,42 @@ SetFsPathFromAny(interp, pathPtr) name[split] = separator; } } - + expandedUser = Tcl_DStringValue(&temp); transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp)); if (split != len) { - /* Join up the tilde substitution with the rest */ - if (name[split+1] == separator) { + /* + * Join up the tilde substitution with the rest. + */ + if (name[split+1] == separator) { /* - * Somewhat tricky case like ~//foo/bar. - * Make use of Split/Join machinery to get it right. - * Assumes all paths beginning with ~ are part of the - * native filesystem. + * Somewhat tricky case like ~//foo/bar. Make use of + * Split/Join machinery to get it right. Assumes all paths + * beginning with ~ are part of the native filesystem. */ int objc; Tcl_Obj **objv; Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL); + Tcl_ListObjGetElements(NULL, parts, &objc, &objv); - /* Skip '~'. It's replaced by its expansion */ + + /* + * Skip '~'. It's replaced by its expansion. + */ + objc--; objv++; while (objc--) { TclpNativeJoinPath(transPtr, TclGetString(*objv++)); } TclDecrRefCount(parts); } else { - /* - * Simple case. "rest" is relative path. Just join it. - * The "rest" object will be freed when - * Tcl_FSJoinToPath returns (unless something else - * claims a refCount on it). + /* + * Simple case. "rest" is relative path. Just join it. The + * "rest" object will be freed when Tcl_FSJoinToPath returns + * (unless something else claims a refCount on it). */ Tcl_Obj *joined; @@ -2311,10 +2351,9 @@ SetFsPathFromAny(interp, pathPtr) 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! + * 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); @@ -2326,17 +2365,16 @@ SetFsPathFromAny(interp, 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. + /* + * 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 = (FsPath *) ckalloc((unsigned)sizeof(FsPath)); fsPathPtr->translatedPathPtr = transPtr; if (transPtr != pathPtr) { - Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); + Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); } fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = NULL; @@ -2358,7 +2396,7 @@ SetFsPathFromAny(interp, pathPtr) static void FreeFsPathInternalRep(pathPtr) - Tcl_Obj *pathPtr; /* Path object with internal rep to free. */ + Tcl_Obj *pathPtr; /* Path object with internal rep to free. */ { FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); @@ -2387,8 +2425,11 @@ FreeFsPathInternalRep(pathPtr) if (fsPathPtr->fsRecPtr != NULL) { fsPathPtr->fsRecPtr->fileRefCount--; if (fsPathPtr->fsRecPtr->fileRefCount <= 0) { - /* It has been unregistered already */ - ckfree((char *)fsPathPtr->fsRecPtr); + /* + * It has been unregistered already. + */ + + ckfree((char *) fsPathPtr->fsRecPtr); } } @@ -2413,7 +2454,7 @@ DupFsPathInternalRep(srcPtr, copyPtr) } else { copyFsPathPtr->translatedPathPtr = NULL; } - + if (srcFsPathPtr->normPathPtr != NULL) { copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr; if (copyFsPathPtr->normPathPtr != copyPtr) { @@ -2422,7 +2463,7 @@ DupFsPathInternalRep(srcPtr, copyPtr) } else { copyFsPathPtr->normPathPtr = NULL; } - + if (srcFsPathPtr->cwdPtr != NULL) { copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr; Tcl_IncrRefCount(copyFsPathPtr->cwdPtr); @@ -2431,13 +2472,13 @@ DupFsPathInternalRep(srcPtr, copyPtr) } copyFsPathPtr->flags = srcFsPathPtr->flags; - - if (srcFsPathPtr->fsRecPtr != NULL + + if (srcFsPathPtr->fsRecPtr != NULL && srcFsPathPtr->nativePathPtr != NULL) { Tcl_FSDupInternalRepProc *dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc; if (dupProc != NULL) { - copyFsPathPtr->nativePathPtr = + copyFsPathPtr->nativePathPtr = (*dupProc)(srcFsPathPtr->nativePathPtr); } else { copyFsPathPtr->nativePathPtr = NULL; @@ -2459,10 +2500,10 @@ DupFsPathInternalRep(srcPtr, copyPtr) * * UpdateStringOfFsPath -- * - * Gives an object a valid string rep. - * + * Gives an object a valid string rep. + * * Results: - * None. + * None. * * Side effects: * Memory may be allocated. @@ -2478,47 +2519,46 @@ UpdateStringOfFsPath(pathPtr) CONST char *cwdStr; int cwdLen; Tcl_Obj *copy; - + if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) { 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. + /* + * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the + * Windows special case? Perhaps we should just check if cwd is a root + * volume. We should never get cwdLen == 0 in this code path. */ switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - if (cwdStr[cwdLen-1] != '/') { - Tcl_AppendToObj(copy, "/", 1); - cwdLen++; - } - break; + case TCL_PLATFORM_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' - */ + 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++; - } + if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { + if (cwdLen != 2 || cwdStr[1] != ':') { + Tcl_AppendToObj(copy, "/", 1); + cwdLen++; } - break; + } + break; } + Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr); pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); pathPtr->length = cwdLen; @@ -2532,17 +2572,15 @@ UpdateStringOfFsPath(pathPtr) * * TclNativePathInFilesystem -- * - * Any path object is acceptable to the native filesystem, by - * default (we will throw errors when illegal paths are actually - * tried to be used). - * - * However, this behavior means the native filesystem must be - * the last filesystem in the lookup list (otherwise it will - * claim all files belong to it, and other filesystems will - * never get a look in). + * Any path object is acceptable to the native filesystem, by default (we + * will throw errors when illegal paths are actually tried to be used). + * + * However, this behavior means the native filesystem must be the last + * filesystem in the lookup list (otherwise it will claim all files + * belong to it, and other filesystems will never get a look in). * * Results: - * TCL_OK, to indicate 'yes', -1 to indicate no. + * TCL_OK, to indicate 'yes', -1 to indicate no. * * Side effects: * None. @@ -2550,44 +2588,57 @@ UpdateStringOfFsPath(pathPtr) *--------------------------------------------------------------------------- */ -int +int TclNativePathInFilesystem(pathPtr, clientDataPtr) Tcl_Obj *pathPtr; ClientData *clientDataPtr; { - /* - * A special case is required to handle the empty path "". - * This is a valid path (i.e. the user should be able - * to do 'file exists ""' without throwing an error), but - * equally the path doesn't exist. Those are the semantics - * of Tcl (at present anyway), so we have to abide by them - * here. + /* + * A special case is required to handle the empty path "". This is a valid + * path (i.e. the user should be able to do 'file exists ""' without + * throwing an error), but equally the path doesn't exist. Those are the + * semantics of Tcl (at present anyway), so we have to abide by them here. */ if (pathPtr->typePtr == &tclFsPathType) { if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') { - /* We reject the empty path "" */ + /* + * We reject the empty path "". + */ return -1; } - /* Otherwise there is no way this path can be empty */ + /* + * Otherwise there is no way this path can be empty. + */ } 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 situation. + /* + * It is somewhat unusual to reach this code path without the object + * being of tclFsPathType. However, we do our best to deal with the + * situation. */ int len; + Tcl_GetStringFromObj(pathPtr, &len); if (len == 0) { - /* We reject the empty path "" */ + /* + * We reject the empty path "". + */ return -1; } } - /* - * Path is of correct type, or is of non-zero length, - * so we accept it. + /* + * Path is of correct type, or is of non-zero length, so we accept it. */ + return TCL_OK; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |