diff options
| -rw-r--r-- | generic/tclEnv.c | 12 | ||||
| -rw-r--r-- | generic/tclFCmd.c | 11 | ||||
| -rw-r--r-- | generic/tclFileName.c | 295 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 14 | ||||
| -rw-r--r-- | generic/tclPathObj.c | 157 | ||||
| -rw-r--r-- | library/safe.tcl | 5 | ||||
| -rw-r--r-- | unix/tclUnixInit.c | 3 | ||||
| -rw-r--r-- | win/tclWinFCmd.c | 15 |
8 files changed, 70 insertions, 442 deletions
diff --git a/generic/tclEnv.c b/generic/tclEnv.c index e469fe9..07cdbb0 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -364,18 +364,6 @@ TclSetEnv( } Tcl_MutexUnlock(&envMutex); - -#ifdef TCL_TILDE_EXPAND - if (!strcmp(name, "HOME")) { - /* - * If the user's home directory has changed, we must invalidate the - * filesystem cache, because '~' expansions will now be incorrect. - */ - - Tcl_FSMountsChanged(NULL); - } -#endif - } /* diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 9a107da..d7fa750 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -882,17 +882,6 @@ FileBasename( Tcl_IncrRefCount(splitPtr); if (objc != 0) { -#ifdef TCL_TILDE_EXPAND - if ((objc == 1) && (*TclGetString(pathPtr) == '~')) { - Tcl_DecrRefCount(splitPtr); - if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { - return NULL; - } - splitPtr = Tcl_FSSplitPath(pathPtr, &objc); - Tcl_IncrRefCount(splitPtr); - } -#endif - /* * Return the last component, unless it is the only component, and it * is the root of an absolute path. diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 3ffdede..d560710 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -362,13 +362,6 @@ Tcl_GetPathType( * file). The exported function Tcl_FSGetPathType should be used by * extensions. * - * If TCL_TILDE_EXPAND defined: - * Note that '~' paths are always considered TCL_PATH_ABSOLUTE, even - * though expanding the '~' could lead to any possible path type. This - * function should therefore be considered a low-level, string - * manipulation function only -- it doesn't actually do any expansion in - * making its determination. - * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or * TCL_PATH_VOLUME_RELATIVE. @@ -389,85 +382,66 @@ TclpGetNativePathType( Tcl_PathType type = TCL_PATH_ABSOLUTE; const char *path = TclGetString(pathPtr); - if (path[0] == '~') { -#ifdef TCL_TILDE_EXPAND - /* - * This case is common to all platforms. Paths that begin with ~ are - * absolute. - */ - - if (driveNameLengthPtr != NULL) { - const char *end = path + 1; - while ((*end != '\0') && (*end != '/')) { - end++; - } - *driveNameLengthPtr = end - path; - } -#else - type = TCL_PATH_RELATIVE; -#endif - } else { - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: { - const char *origPath = path; + switch (tclPlatform) { + case TCL_PLATFORM_UNIX: { + const char *origPath = path; - /* - * Paths that begin with / are absolute. - */ + /* + * Paths that begin with / are absolute. + */ - if (path[0] == '/') { - ++path; + if (path[0] == '/') { + ++path; #if defined(__CYGWIN__) || defined(__QNX__) - /* - * Check for "//" network path prefix - */ - if ((*path == '/') && path[1] && (path[1] != '/')) { - path += 2; - while (*path && *path != '/') { - ++path; - } + /* + * Check for "//" network path prefix + */ + if ((*path == '/') && path[1] && (path[1] != '/')) { + path += 2; + while (*path && *path != '/') { + ++path; + } #if defined(__CYGWIN__) - /* UNC paths need to be followed by a share name */ - if (*path++ && (*path && *path != '/')) { - ++path; - while (*path && *path != '/') { - ++path; - } - } else { - path = origPath + 1; - } + /* UNC paths need to be followed by a share name */ + if (*path++ && (*path && *path != '/')) { + ++path; + while (*path && *path != '/') { + ++path; + } + } else { + path = origPath + 1; + } #endif - } + } #endif - if (driveNameLengthPtr != NULL) { - /* - * We need this addition in case the QNX or Cygwin code was used. - */ - - *driveNameLengthPtr = (path - origPath); - } - } else { - type = TCL_PATH_RELATIVE; - } - break; - } - case TCL_PLATFORM_WINDOWS: { - Tcl_DString ds; - const char *rootEnd; - - Tcl_DStringInit(&ds); - rootEnd = ExtractWinRoot(path, &ds, 0, &type); - if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { - *driveNameLengthPtr = rootEnd - path; - if (driveNameRef != NULL) { - *driveNameRef = TclDStringToObj(&ds); - Tcl_IncrRefCount(*driveNameRef); - } - } - Tcl_DStringFree(&ds); - break; - } - } + if (driveNameLengthPtr != NULL) { + /* + * We need this addition in case the QNX or Cygwin code was used. + */ + + *driveNameLengthPtr = (path - origPath); + } + } else { + type = TCL_PATH_RELATIVE; + } + break; + } + case TCL_PLATFORM_WINDOWS: { + Tcl_DString ds; + const char *rootEnd; + + Tcl_DStringInit(&ds); + rootEnd = ExtractWinRoot(path, &ds, 0, &type); + if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { + *driveNameLengthPtr = rootEnd - path; + if (driveNameRef != NULL) { + *driveNameRef = TclDStringToObj(&ds); + Tcl_IncrRefCount(*driveNameRef); + } + } + Tcl_DStringFree(&ds); + break; + } } return type; } @@ -702,16 +676,7 @@ SplitUnixPath( length = path - elementStart; if (length > 0) { Tcl_Obj *nextElt; -#ifdef TCL_TILDE_EXPAND - if ((elementStart[0] == '~') && (elementStart != origPath)) { - TclNewLiteralStringObj(nextElt, "./"); - Tcl_AppendToObj(nextElt, elementStart, length); - } else { - nextElt = Tcl_NewStringObj(elementStart, length); - } -#else nextElt = Tcl_NewStringObj(elementStart, length); -#endif Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*path++ == '\0') { @@ -775,12 +740,9 @@ SplitWinPath( length = p - elementStart; if (length > 0) { Tcl_Obj *nextElt; - if ((elementStart != path) && - ( -#ifdef TCL_TILDE_EXPAND - (elementStart[0] == '~') || -#endif - (isalpha(UCHAR(elementStart[0])) && elementStart[1] == ':'))) { + if ((elementStart != path) && + isalpha(UCHAR(elementStart[0])) && + (elementStart[1] == ':')) { TclNewLiteralStringObj(nextElt, "./"); Tcl_AppendToObj(nextElt, elementStart, length); } else { @@ -885,14 +847,10 @@ TclpNativeJoinPath( if (length != 0) { if ((p[0] == '.') && (p[1] == '/') && - ( -#ifdef TCL_TILDE_EXPAND - (p[2] == '~') || -#endif - (tclPlatform==TCL_PLATFORM_WINDOWS && - isalpha(UCHAR(p[2])) && - (p[3] == ':')))) { - p += 2; + (tclPlatform==TCL_PLATFORM_WINDOWS) && + isalpha(UCHAR(p[2])) && + (p[3] == ':')) { + p += 2; } } if (*p == '\0') { @@ -1164,67 +1122,6 @@ TclGetExtension( return p; } -#ifdef TCL_TILDE_EXPAND -/* - *---------------------------------------------------------------------- - * - * DoTildeSubst -- - * - * Given a string following a tilde, this routine returns the - * corresponding home directory. - * - * Results: - * The result is a pointer to a static string containing the home - * directory in native format. If there was an error in processing the - * substitution, then an error message is left in the interp's result and - * the return value is NULL. On success, the results are appended to - * resultPtr, and the contents of resultPtr are returned. - * - * Side effects: - * Information may be left in resultPtr. - * - *---------------------------------------------------------------------- - */ - -static const char * -DoTildeSubst( - Tcl_Interp *interp, /* Interpreter in which to store error message - * (if necessary). */ - const char *user, /* Name of user whose home directory should be - * substituted, or "" for current user. */ - Tcl_DString *resultPtr) /* Initialized DString filled with name after - * tilde substitution. */ -{ - const char *dir; - - if (*user == '\0') { - Tcl_DString dirString; - - dir = TclGetEnv("HOME", &dirString); - if (dir == NULL) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment " - "variable to expand path", -1)); - Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL); - } - return NULL; - } - Tcl_JoinPath(1, &dir, resultPtr); - Tcl_DStringFree(&dirString); - } else if (TclpGetUserHome(user, resultPtr) == NULL) { - if (interp) { - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", user)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL); - } - return NULL; - } - return Tcl_DStringValue(resultPtr); -} -#endif /* TCL_TILDE_EXPAND */ - /* *---------------------------------------------------------------------- * @@ -1749,7 +1646,7 @@ TclGlob( * NULL. */ { const char *separators; - char *tail, *start; + char *tail; int result; Tcl_Obj *filenamesObj, *savedResultObj; @@ -1763,65 +1660,10 @@ TclGlob( break; } - if (pathPrefix == NULL) { - Tcl_DString buffer; - Tcl_DStringInit(&buffer); - - start = pattern; - - /* - * Perform tilde substitution, if needed. - */ - -#ifdef TCL_TILDE_EXPAND - if (start[0] == '~') { - const char *head; - char c; - /* - * Find the first path separator after the tilde. - */ - - for (tail = start; *tail != '\0'; tail++) { - if (*tail == '\\') { - if (strchr(separators, tail[1]) != NULL) { - break; - } - } else if (strchr(separators, *tail) != NULL) { - break; - } - } - - /* - * Determine the home directory for the specified user. - */ - - c = *tail; - *tail = '\0'; - head = DoTildeSubst(interp, start+1, &buffer); - *tail = c; - if (head == NULL) { - return TCL_ERROR; - } - if (head != Tcl_DStringValue(&buffer)) { - Tcl_DStringAppend(&buffer, head, -1); - } - pathPrefix = TclDStringToObj(&buffer); - Tcl_IncrRefCount(pathPrefix); - globFlags |= TCL_GLOBMODE_DIR; - if (c != '\0') { - tail++; - } - Tcl_DStringFree(&buffer); - } else { - tail = pattern; - } -#else - tail = pattern; -#endif /* TCL_TILDE_EXPAND */ - } else { + if (pathPrefix != NULL) { Tcl_IncrRefCount(pathPrefix); - tail = pattern; } + tail = pattern; /* * Handling empty path prefixes with glob patterns like 'C:' or @@ -2375,15 +2217,6 @@ DoGlob( for (i=0; result==TCL_OK && i<subdirc; i++) { Tcl_Obj *copy = NULL; -#ifdef TCL_TILDE_EXPAND - if (pathPtr == NULL && TclGetString(subdirv[i])[0] == '~') { - TclListObjLengthM(NULL, matchesObj, &repair); - copy = subdirv[i]; - subdirv[i] = Tcl_NewStringObj("./", 2); - Tcl_AppendObjToObj(subdirv[i], copy); - Tcl_IncrRefCount(subdirv[i]); - } -#endif /* TCL_TILDE_EXPAND */ result = DoGlob(interp, matchesObj, separators, subdirv[i], 1, p+1, types); if (copy) { diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 50346b6..d7322f7 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1213,9 +1213,7 @@ FsAddMountsToGlobResult( * native file system; see note below). * * (4) The mapping from a string representation of a file to a full, - * normalized pathname changes. For example, if 'env(HOME)' is modified, - * then any pathname containing '~' maps to a different item, possibly in - * a different filesystem. (Only if TCL_TILDE_EXPAND is defined) + * normalized pathname changes. * * Tcl has no control over (2) and (3), so each registered filesystem must * call Tcl_FSMountsChnaged in each of those circumstances. @@ -3938,17 +3936,7 @@ Tcl_FSSplitPath( length = p - elementStart; if (length > 0) { Tcl_Obj *nextElt; - -#ifdef TCL_TILDE_EXPAND - if (elementStart[0] == '~') { - TclNewLiteralStringObj(nextElt, "./"); - Tcl_AppendToObj(nextElt, elementStart, length); - } else { - nextElt = Tcl_NewStringObj(elementStart, length); - } -#else nextElt = Tcl_NewStringObj(elementStart, length); -#endif /* TCL_TILDE_EXPAND */ Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*p++ == '\0') { diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index c123613..82b79f5 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -699,19 +699,7 @@ TclPathPart( splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); Tcl_IncrRefCount(splitPtr); -#ifdef TCL_TILDE_EXPAND - if (splitElements == 1 && TclGetString(pathPtr)[0] == '~') { - Tcl_Obj *norm; - TclDecrRefCount(splitPtr); - norm = Tcl_FSGetNormalizedPath(interp, pathPtr); - if (norm == NULL) { - return NULL; - } - splitPtr = Tcl_FSSplitPath(norm, &splitElements); - Tcl_IncrRefCount(splitPtr); - } -#endif /* TCL_TILDE_EXPAND */ if (portion == TCL_PATH_TAIL) { /* * Return the last component, unless it is the only component, and @@ -1040,18 +1028,6 @@ TclJoinPath( } ptr = Tcl_GetStringFromObj(res, &length); -#ifdef TCL_TILDE_EXPAND - /* - * Strip off any './' before a tilde, unless this is the beginning of - * the path. - */ - - if (length > 0 && strEltLen > 0 && (strElt[0] == '.') && - (strElt[1] == '/') && (strElt[2] == '~')) { - strElt += 2; - } -#endif /* TCL_TILDE_EXPAND */ - /* * 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 @@ -1250,8 +1226,10 @@ TclNewFSPathObj( const char *p; int state = 0, count = 0; -#ifdef TCL_TILDE_EXPAND - /* [Bug 2806250] - this is only a partial solution of the problem. + /* + * This comment is kept from the days of tilde expansion because + * it is illustrative of a more general problem. + * [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, @@ -1267,14 +1245,6 @@ TclNewFSPathObj( * 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); - - pathPtr = AppendPath(dirPtr, tail); - Tcl_DecrRefCount(tail); - return pathPtr; - } -#endif /* TCL_TILDE_EXPAND */ TclNewObj(pathPtr); fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath)); @@ -2231,126 +2201,7 @@ SetFsPathFromAny( */ name = Tcl_GetStringFromObj(pathPtr, &len); - - /* - * Handle tilde substitutions, if needed. - */ - -#ifdef TCL_TILDE_EXPAND - if (len && name[0] == '~') { - Tcl_DString temp; - size_t split; - char separator = '/'; - - /* - * We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc. - * split becomes value 1 for '~/...' as well as for '~'. - */ - split = FindSplitPos(name, separator); - - /* - * Do some tilde substitution. - */ - - if (split == 1) { - /* - * We have just '~' (or '~/...') - */ - - const char *dir; - Tcl_DString dirString; - - dir = TclGetEnv("HOME", &dirString); - if (dir == NULL) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment variable to" - " expand path", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", - "HOMELESS", NULL); - } - return TCL_ERROR; - } - Tcl_DStringInit(&temp); - Tcl_JoinPath(1, &dir, &temp); - Tcl_DStringFree(&dirString); - } else { - /* - * There is a '~user' - */ - - const char *expandedUser; - Tcl_DString userName; - - Tcl_DStringInit(&userName); - Tcl_DStringAppend(&userName, name+1, split-1); - expandedUser = Tcl_DStringValue(&userName); - - Tcl_DStringInit(&temp); - if (TclpGetUserHome(expandedUser, &temp) == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", expandedUser)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", - NULL); - } - Tcl_DStringFree(&userName); - Tcl_DStringFree(&temp); - return TCL_ERROR; - } - Tcl_DStringFree(&userName); - } - - transPtr = TclDStringToObj(&temp); - - if (split != len) { - /* - * 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. - */ - - size_t objc; - Tcl_Obj **objv; - Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL); - - TclListObjGetElementsM(NULL, parts, &objc, &objv); - - /* - * Skip '~'. It's replaced by its expansion. - */ - - objc--; objv++; - while (objc--) { - TclpNativeJoinPath(transPtr, TclGetString(*objv)); - objv++; - } - TclDecrRefCount(parts); - } else { - Tcl_Obj *pair[2]; - - pair[0] = transPtr; - pair[1] = Tcl_NewStringObj(name+split+1, -1); - transPtr = TclJoinPath(2, pair, 1); - if (transPtr != pair[0]) { - Tcl_DecrRefCount(pair[0]); - } - if (transPtr != pair[1]) { - Tcl_DecrRefCount(pair[1]); - } - } - } - } else { - transPtr = TclJoinPath(1, &pathPtr, 1); - } -#else transPtr = TclJoinPath(1, &pathPtr, 1); -#endif /* TCL_TILDE_EXPAND */ /* * Now we have a translated filename in 'transPtr'. This will have forward diff --git a/library/safe.tcl b/library/safe.tcl index 09c82e5..c082c33 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -733,11 +733,6 @@ proc ::safe::CheckFileName {child file} { # prevent discovery of what home directories exist. proc ::safe::AliasFileSubcommand {child subcommand name} { - # TODO - if TIP602 is accepted for Tcl9, this check could be removed. - # The check is required if TCL_TILDE_EXPAND is defined. - if {[string match ~* $name]} { - set name ./$name - } tailcall ::interp invokehidden $child tcl:file:$subcommand $name } diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index cb74630..148caa0 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -863,8 +863,8 @@ TclpSetVariables( Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY); } -#ifndef TCL_TILDE_EXPAND { + /* Some platforms build configure scripts expect ~ expansion so do that */ Tcl_Obj *origPaths; Tcl_Obj *resolvedPaths; origPaths = Tcl_GetVar2Ex(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); @@ -874,7 +874,6 @@ TclpSetVariables( resolvedPaths, TCL_GLOBAL_ONLY); } } -#endif #ifdef DJGPP Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY); diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 5f55354..e52874e 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1715,22 +1715,7 @@ ConvertFileNameFormat( Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp); Tcl_DStringFree(&ds); - /* - * Deal with issues of tildes being absolute. - */ - -#ifdef TCL_TILDE_EXPAND - if (Tcl_DStringValue(&dsTemp)[0] == '~') { - TclNewLiteralStringObj(tempPath, "./"); - Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), - Tcl_DStringLength(&dsTemp)); - Tcl_DStringFree(&dsTemp); - } else { - tempPath = TclDStringToObj(&dsTemp); - } -#else tempPath = TclDStringToObj(&dsTemp); -#endif /* TCL_TILDE_EXPAND */ Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); FindClose(handle); } |