diff options
Diffstat (limited to 'generic/tclFileName.c')
| -rw-r--r-- | generic/tclFileName.c | 604 |
1 files changed, 356 insertions, 248 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 7be9c0e..06e83a3 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -4,12 +4,13 @@ * This file contains routines for converting file names betwen * native and network form. * - * Copyright (c) 1995-1996 Sun Microsystems, Inc. + * Copyright (c) 1995-1998 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclFileName.c,v 1.5 1999/03/10 05:52:48 stanton Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.6 1999/04/16 00:46:46 stanton Exp $ */ #include "tclInt.h" @@ -17,19 +18,12 @@ #include "tclRegexp.h" /* - * This variable indicates whether the cleanup procedure has been - * registered for this file yet. - */ - -static int initialized = 0; - -/* * The following regular expression matches the root portion of a Windows * absolute or volume relative path. It will match both UNC and drive relative * paths. */ -#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\][/\\]+([^/\\]+)[/\\]+([^/\\]+)|([/\\]))([/\\])*" +#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\\\][/\\\\]+([^/\\\\]+)[/\\\\]+([^/\\\\]+)|([/\\\\]))([/\\\\])*" /* * The following regular expression matches the root portion of a Macintosh @@ -44,8 +38,13 @@ static int initialized = 0; * for use in filename matching. */ -static regexp *winRootPatternPtr = NULL; -static regexp *macRootPatternPtr = NULL; +typedef struct ThreadSpecificData { + int initialized; + Tcl_Obj *winRootPatternPtr; + Tcl_Obj *macRootPatternPtr; +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; /* * The following variable is set in the TclPlatformInit call to one @@ -59,22 +58,51 @@ TclPlatformType tclPlatform = TCL_PLATFORM_UNIX; */ static char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp, - char *user, Tcl_DString *resultPtr)); -static char * ExtractWinRoot _ANSI_ARGS_((char *path, + CONST char *user, Tcl_DString *resultPtr)); +static CONST char * ExtractWinRoot _ANSI_ARGS_((CONST char *path, Tcl_DString *resultPtr, int offset)); static void FileNameCleanup _ANSI_ARGS_((ClientData clientData)); +static void FileNameInit _ANSI_ARGS_((void)); static int SkipToChar _ANSI_ARGS_((char **stringPtr, char *match)); -static char * SplitMacPath _ANSI_ARGS_((char *path, +static char * SplitMacPath _ANSI_ARGS_((CONST char *path, Tcl_DString *bufPtr)); -static char * SplitWinPath _ANSI_ARGS_((char *path, +static char * SplitWinPath _ANSI_ARGS_((CONST char *path, Tcl_DString *bufPtr)); -static char * SplitUnixPath _ANSI_ARGS_((char *path, +static char * SplitUnixPath _ANSI_ARGS_((CONST char *path, Tcl_DString *bufPtr)); /* *---------------------------------------------------------------------- * + * FileNameInit -- + * + * This procedure initializes the patterns used by this module. + * + * Results: + * None. + * + * Side effects: + * Compiles the regular expressions. + * + *---------------------------------------------------------------------- + */ + +static void +FileNameInit() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + if (!tsdPtr->initialized) { + tsdPtr->initialized = 1; + tsdPtr->winRootPatternPtr = Tcl_NewStringObj(WIN_ROOT_PATTERN, -1); + tsdPtr->macRootPatternPtr = Tcl_NewStringObj(MAC_ROOT_PATTERN, -1); + Tcl_CreateThreadExitHandler(FileNameCleanup, NULL); + } +} + +/* + *---------------------------------------------------------------------- + * * FileNameCleanup -- * * This procedure is a Tcl_ExitProc used to clean up the static @@ -93,15 +121,10 @@ static void FileNameCleanup(clientData) ClientData clientData; /* Not used. */ { - if (winRootPatternPtr != NULL) { - ckfree((char *)winRootPatternPtr); - winRootPatternPtr = (regexp *) NULL; - } - if (macRootPatternPtr != NULL) { - ckfree((char *)macRootPatternPtr); - macRootPatternPtr = (regexp *) NULL; - } - initialized = 0; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + Tcl_DecrRefCount(tsdPtr->winRootPatternPtr); + Tcl_DecrRefCount(tsdPtr->macRootPatternPtr); + tsdPtr->initialized = 0; } /* @@ -124,55 +147,59 @@ FileNameCleanup(clientData) *---------------------------------------------------------------------- */ -static char * +static CONST char * ExtractWinRoot(path, resultPtr, offset) - char *path; /* Path to parse. */ + CONST char *path; /* Path to parse. */ Tcl_DString *resultPtr; /* Buffer to hold result. */ int offset; /* Offset in buffer where result should be * stored. */ { int length; + Tcl_RegExp re; + char *dummy, *tail, *drive, *hostStart, *hostEnd, *shareStart, + *shareEnd, *lastSlash; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Initialize the path name parser for Windows path names. */ - if (winRootPatternPtr == NULL) { - winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN); - if (!initialized) { - Tcl_CreateExitHandler(FileNameCleanup, NULL); - initialized = 1; - } - } + FileNameInit(); + + re = Tcl_GetRegExpFromObj(NULL, tsdPtr->winRootPatternPtr, REG_ADVANCED); /* * Match the root portion of a Windows path name. */ - if (!TclRegExec(winRootPatternPtr, path, path)) { + if (!Tcl_RegExpExec(NULL, re, path, path)) { return path; } Tcl_DStringSetLength(resultPtr, offset); - if (winRootPatternPtr->startp[2] != NULL) { - Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[2], 2); - if (winRootPatternPtr->startp[6] != NULL) { + Tcl_RegExpRange(re, 0, &dummy, &tail); + Tcl_RegExpRange(re, 2, &drive, &dummy); + Tcl_RegExpRange(re, 3, &hostStart, &hostEnd); + Tcl_RegExpRange(re, 4, &shareStart, &shareEnd); + Tcl_RegExpRange(re, 6, &lastSlash, &dummy); + + if (drive != NULL) { + Tcl_DStringAppend(resultPtr, drive, 2); + if (lastSlash != NULL) { Tcl_DStringAppend(resultPtr, "/", 1); } - } else if (winRootPatternPtr->startp[4] != NULL) { + } else if (shareStart != NULL) { Tcl_DStringAppend(resultPtr, "//", 2); - length = winRootPatternPtr->endp[3] - - winRootPatternPtr->startp[3]; - Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[3], length); + length = hostEnd - hostStart; + Tcl_DStringAppend(resultPtr, hostStart, length); Tcl_DStringAppend(resultPtr, "/", 1); - length = winRootPatternPtr->endp[4] - - winRootPatternPtr->startp[4]; - Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[4], length); + length = shareEnd - shareStart; + Tcl_DStringAppend(resultPtr, shareStart, length); } else { Tcl_DStringAppend(resultPtr, "/", 1); } - return winRootPatternPtr->endp[0]; + return tail; } /* @@ -197,7 +224,9 @@ Tcl_PathType Tcl_GetPathType(path) char *path; { + ThreadSpecificData *tsdPtr; Tcl_PathType type = TCL_PATH_ABSOLUTE; + Tcl_RegExp re; switch (tclPlatform) { case TCL_PLATFORM_UNIX: @@ -214,45 +243,51 @@ Tcl_GetPathType(path) if (path[0] == ':') { type = TCL_PATH_RELATIVE; } else if (path[0] != '~') { + tsdPtr = TCL_TSD_INIT(&dataKey); /* * Since we have eliminated the easy cases, use the * root pattern to look for the other types. */ - if (!macRootPatternPtr) { - macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN); - if (!initialized) { - Tcl_CreateExitHandler(FileNameCleanup, NULL); - initialized = 1; - } - } - if (!TclRegExec(macRootPatternPtr, path, path) - || (macRootPatternPtr->startp[2] != NULL)) { + FileNameInit(); + re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr, + REG_ADVANCED); + + if (!Tcl_RegExpExec(NULL, re, path, path)) { type = TCL_PATH_RELATIVE; + } else { + char *unixRoot, *dummy; + + Tcl_RegExpRange(re, 2, &unixRoot, &dummy); + if (unixRoot) { + type = TCL_PATH_RELATIVE; + } } } break; case TCL_PLATFORM_WINDOWS: if (path[0] != '~') { + tsdPtr = TCL_TSD_INIT(&dataKey); /* * Since we have eliminated the easy cases, check for * drive relative paths using the regular expression. */ - if (!winRootPatternPtr) { - winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN); - if (!initialized) { - Tcl_CreateExitHandler(FileNameCleanup, NULL); - initialized = 1; - } - } - if (TclRegExec(winRootPatternPtr, path, path)) { - if (winRootPatternPtr->startp[5] - || (winRootPatternPtr->startp[2] - && !(winRootPatternPtr->startp[6]))) { + FileNameInit(); + re = Tcl_GetRegExpFromObj(NULL, tsdPtr->winRootPatternPtr, + REG_ADVANCED); + + if (Tcl_RegExpExec(NULL, re, path, path)) { + char *drive, *dummy, *unixRoot, *lastSlash; + + Tcl_RegExpRange(re, 2, &drive, &dummy); + Tcl_RegExpRange(re, 5, &unixRoot, &dummy); + Tcl_RegExpRange(re, 6, &lastSlash, &dummy); + + if (unixRoot || (drive && !lastSlash)) { type = TCL_PATH_VOLUME_RELATIVE; } } else { @@ -292,7 +327,7 @@ Tcl_GetPathType(path) void Tcl_SplitPath(path, argcPtr, argvPtr) - char *path; /* Pointer to string containing a path. */ + CONST char *path; /* Pointer to string containing a path. */ int *argcPtr; /* Pointer to location to fill in with * the number of elements in the path. */ char ***argvPtr; /* Pointer to place to store pointer to array @@ -301,6 +336,7 @@ Tcl_SplitPath(path, argcPtr, argvPtr) int i, size; char *p; Tcl_DString buffer; + Tcl_DStringInit(&buffer); /* @@ -385,11 +421,11 @@ Tcl_SplitPath(path, argcPtr, argvPtr) static char * SplitUnixPath(path, bufPtr) - char *path; /* Pointer to string containing a path. */ + CONST char *path; /* Pointer to string containing a path. */ Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */ { int length; - char *p, *elementStart; + CONST char *p, *elementStart; /* * Deal with the root directory as a special case. @@ -447,11 +483,11 @@ SplitUnixPath(path, bufPtr) static char * SplitWinPath(path, bufPtr) - char *path; /* Pointer to string containing a path. */ + CONST char *path; /* Pointer to string containing a path. */ Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */ { int length; - char *p, *elementStart; + CONST char *p, *elementStart; p = ExtractWinRoot(path, bufPtr, 0); @@ -505,88 +541,98 @@ SplitWinPath(path, bufPtr) static char * SplitMacPath(path, bufPtr) - char *path; /* Pointer to string containing a path. */ + CONST char *path; /* Pointer to string containing a path. */ Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */ { int isMac = 0; /* 1 if is Mac-style, 0 if Unix-style path. */ int i, length; - char *p, *elementStart; + CONST char *p, *elementStart; + Tcl_RegExp re; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Initialize the path name parser for Macintosh path names. */ - if (macRootPatternPtr == NULL) { - macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN); - if (!initialized) { - Tcl_CreateExitHandler(FileNameCleanup, NULL); - initialized = 1; - } - } + FileNameInit(); /* * Match the root portion of a Mac path name. */ i = 0; /* Needed only to prevent gcc warnings. */ - if (TclRegExec(macRootPatternPtr, path, path) == 1) { + + re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr, REG_ADVANCED); + + if (Tcl_RegExpExec(NULL, re, path, path) == 1) { + char *start, *end; + /* * Treat degenerate absolute paths like / and /../.. as * Mac relative file names for lack of anything else to do. */ - if (macRootPatternPtr->startp[2] != NULL) { + Tcl_RegExpRange(re, 2, &start, &end); + if (start) { Tcl_DStringAppend(bufPtr, ":", 1); - Tcl_DStringAppend(bufPtr, path, macRootPatternPtr->endp[0] - - macRootPatternPtr->startp[0] + 1); + Tcl_RegExpRange(re, 0, &start, &end); + Tcl_DStringAppend(bufPtr, path, end - start + 1); return Tcl_DStringValue(bufPtr); } - if (macRootPatternPtr->startp[5] != NULL) { - + Tcl_RegExpRange(re, 5, &start, &end); + if (start) { /* * Unix-style tilde prefixed paths. */ isMac = 0; i = 5; - } else if (macRootPatternPtr->startp[7] != NULL) { - - /* - * Mac-style tilde prefixed paths. - */ + } else { + Tcl_RegExpRange(re, 7, &start, &end); + if (start) { + /* + * Mac-style tilde prefixed paths. + */ - isMac = 1; - i = 7; - } else if (macRootPatternPtr->startp[10] != NULL) { + isMac = 1; + i = 7; + } else { + Tcl_RegExpRange(re, 10, &start, &end); + if (start) { - /* - * Normal Unix style paths. - */ + /* + * Normal Unix style paths. + */ - isMac = 0; - i = 10; - } else if (macRootPatternPtr->startp[12] != NULL) { + isMac = 0; + i = 10; + } else { + Tcl_RegExpRange(re, 12, &start, &end); + if (start) { - /* - * Normal Mac style paths. - */ + /* + * Normal Mac style paths. + */ - isMac = 1; - i = 12; + isMac = 1; + i = 12; + } + } + } } - length = macRootPatternPtr->endp[i] - - macRootPatternPtr->startp[i]; + Tcl_RegExpRange(re, i, &start, &end); + length = end - start; /* * Append the element and terminate it with a : and a null. Note that * we are forcing the DString to contain an extra null at the end. */ - Tcl_DStringAppend(bufPtr, macRootPatternPtr->startp[i], length); + Tcl_DStringAppend(bufPtr, start, length); Tcl_DStringAppend(bufPtr, ":", 2); - p = macRootPatternPtr->endp[i]; + p = end; } else { isMac = (strchr(path, ':') != NULL); p = path; @@ -690,7 +736,8 @@ Tcl_JoinPath(argc, argv, resultPtr) { int oldLength, length, i, needsSep; Tcl_DString buffer; - char *p, c, *dest; + char c, *dest; + CONST char *p; Tcl_DStringInit(&buffer); oldLength = Tcl_DStringLength(resultPtr); @@ -884,25 +931,27 @@ Tcl_JoinPath(argc, argv, resultPtr) } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * * Tcl_TranslateFileName -- * * Converts a file name into a form usable by the native system - * interfaces. If the name starts with a tilde, it will produce - * a name where the tilde and following characters have been - * replaced by the home directory location for the named user. + * interfaces. If the name starts with a tilde, it will produce a + * name where the tilde and following characters have been replaced + * by the home directory location for the named user. * * Results: - * The result is a pointer to a static string containing - * the new name. If there was an error in processing the - * name, then an error message is left in interp->result - * and the return value is NULL. The result will be stored - * in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr) - * to free the name if the return value was not NULL. + * The return value is a pointer to a string containing the name + * after tilde substitution. If there was no tilde substitution, + * the return value is a pointer to a copy of the original string. + * If there was an error in processing the name, then an error + * message is left in the interp's result (if interp was not NULL) + * and the return value is NULL. Space for the return value is + * allocated in bufferPtr; the caller must call Tcl_DStringFree() + * to free the space if the return value was not NULL. * * Side effects: - * Information may be left in bufferPtr. + * None. * *---------------------------------------------------------------------- */ @@ -911,13 +960,12 @@ char * Tcl_TranslateFileName(interp, name, bufferPtr) Tcl_Interp *interp; /* Interpreter in which to store error * message (if necessary). */ - char *name; /* File name, which may begin with "~" - * (to indicate current user's home directory) - * or "~<user>" (to indicate any user's - * home directory). */ - Tcl_DString *bufferPtr; /* May be used to hold result. Must not hold - * anything at the time of the call, and need - * not even be initialized. */ + char *name; /* File name, which may begin with "~" (to + * indicate current user's home directory) or + * "~<user>" (to indicate any user's home + * directory). */ + Tcl_DString *bufferPtr; /* Uninitialized or free DString filled + * with name after tilde substitution. */ { register char *p; @@ -933,8 +981,8 @@ Tcl_TranslateFileName(interp, name, bufferPtr) Tcl_SplitPath(name, &argc, &argv); /* - * Strip the trailing ':' off of a Mac path - * before passing the user name to DoTildeSubst. + * Strip the trailing ':' off of a Mac path before passing the user + * name to DoTildeSubst. */ if (tclPlatform == TCL_PLATFORM_MAC) { @@ -1051,9 +1099,10 @@ TclGetExtension(name) * 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 interp->result - * and the return value is NULL. On success, the results are appended - * to resultPtr, and the contents of resultPtr are returned. + * 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. @@ -1065,16 +1114,17 @@ static char * DoTildeSubst(interp, user, resultPtr) Tcl_Interp *interp; /* Interpreter in which to store error * message (if necessary). */ - char *user; /* Name of user whose home directory should be + CONST char *user; /* Name of user whose home directory should be * substituted, or "" for current user. */ - Tcl_DString *resultPtr; /* May be used to hold result. Must not hold - * anything at the time of the call, and need - * not even be initialized. */ + Tcl_DString *resultPtr; /* Initialized DString filled with name + * after tilde substitution. */ { char *dir; if (*user == '\0') { - dir = TclGetEnv("HOME"); + Tcl_DString dirString; + + dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { Tcl_ResetResult(interp); @@ -1084,13 +1134,16 @@ DoTildeSubst(interp, user, resultPtr) return NULL; } Tcl_JoinPath(1, &dir, resultPtr); - } else if (TclGetUserHome(user, resultPtr) == NULL) { - if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist", - (char *) NULL); + Tcl_DStringFree(&dirString); + } else { + if (TclpGetUserHome(user, resultPtr) == NULL) { + if (interp) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist", + (char *) NULL); + } + return NULL; } - return NULL; } return resultPtr->string; } @@ -1098,7 +1151,7 @@ DoTildeSubst(interp, user, resultPtr) /* *---------------------------------------------------------------------- * - * Tcl_GlobCmd -- + * Tcl_GlobObjCmd -- * * This procedure is invoked to process the "glob" Tcl command. * See the user documentation for details on what it does. @@ -1114,42 +1167,104 @@ DoTildeSubst(interp, user, resultPtr) /* ARGSUSED */ int -Tcl_GlobCmd(dummy, interp, argc, argv) +Tcl_GlobObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - int i, noComplain, firstArg; - char c; - int result = TCL_OK; - Tcl_DString buffer; - char *separators, *head, *tail; + int index, i, noComplain, skip, length; + char *string; + static char *options[] = {"-nocomplain", "--", NULL}; + enum options {GLOB_NOCOMPLAIN, GLOB_LAST}; noComplain = 0; - for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-'); - firstArg++) { - if (strcmp(argv[firstArg], "-nocomplain") == 0) { - noComplain = 1; - } else if (strcmp(argv[firstArg], "--") == 0) { - firstArg++; + for (skip = 1; skip < objc; skip++) { + string = Tcl_GetString(objv[skip]); + if (string[0] != '-') { break; - } else { - Tcl_AppendResult(interp, "bad switch \"", argv[firstArg], - "\": must be -nocomplain or --", (char *) NULL); + } + if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch", + TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } + if (index == GLOB_NOCOMPLAIN) { + noComplain = 1; + } else { + skip++; + break; + } } - if (firstArg >= argc) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ?switches? name ?name ...?\"", (char *) NULL); + if (skip >= objc) { + Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?"); return TCL_ERROR; } - Tcl_DStringInit(&buffer); - separators = NULL; /* Needed only to prevent gcc warnings. */ - for (i = firstArg; i < argc; i++) { - switch (tclPlatform) { + for (i = skip; i < objc; i++) { + string = Tcl_GetString(objv[i]); + if (TclGlob(interp, string, noComplain) != TCL_OK) { + return TCL_ERROR; + } + } + if (noComplain == 0) { + Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); + if (length == 0) { + char *sep = ""; + + Tcl_AppendResult(interp, "no files matched glob pattern", + (objc == 2) ? " \"" : "s \"", (char *) NULL); + for (i = skip; i < objc; i++) { + string = Tcl_GetString(objv[i]); + Tcl_AppendResult(interp, sep, string, (char *) NULL); + sep = " "; + } + Tcl_AppendResult(interp, "\"", (char *) NULL); + return TCL_ERROR; + } + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclGlob -- + * + * This procedure prepares arguments for the TclDoGlob call. + * It sets the separator string based on the platform, performs + * tilde substitution, and calls TclDoGlob. + * + * Results: + * The return value is a standard Tcl result indicating whether + * an error occurred in globbing. After a normal return the + * result in interp (set by TclDoGlob) holds all of the file names + * given by the dir and rem arguments. After an error the + * result in interp will hold an error message. + * + * Side effects: + * The currentArgString is written to. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +int +TclGlob(interp, pattern, noComplain) + Tcl_Interp *interp; /* Interpreter for returning error message + * or appending list of matching file names. */ + char *pattern; /* Glob pattern to match. Must not refer + * to a static string. */ + int noComplain; /* Flag to turn off storing error messages + * in interp. */ +{ + char *separators; + char *head, *tail; + char c; + int result; + Tcl_DString buffer; + + separators = NULL; /* lint. */ + switch (tclPlatform) { case TCL_PLATFORM_UNIX: separators = "/"; break; @@ -1157,102 +1272,84 @@ Tcl_GlobCmd(dummy, interp, argc, argv) separators = "/\\:"; break; case TCL_PLATFORM_MAC: - separators = (strchr(argv[i], ':') == NULL) ? "/" : ":"; + separators = (strchr(pattern, ':') == NULL) + ? "/" : ":"; break; - } + } - Tcl_DStringSetLength(&buffer, 0); + Tcl_DStringInit(&buffer); - /* - * Perform tilde substitution, if needed. - */ + /* + * Perform tilde substitution, if needed. + */ - if (argv[i][0] == '~') { - char *p; + if (pattern[0] == '~') { + char *p; - /* - * Find the first path separator after the tilde. - */ + /* + * Find the first path separator after the tilde. + */ - for (tail = argv[i]; *tail != '\0'; tail++) { - if (*tail == '\\') { - if (strchr(separators, tail[1]) != NULL) { - break; - } - } else if (strchr(separators, *tail) != NULL) { + for (tail = pattern; *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. Note that - * we don't allow special characters in the user name. - */ - - c = *tail; - *tail = '\0'; - p = strpbrk(argv[i]+1, "\\[]*?{}"); - if (p == NULL) { - head = DoTildeSubst(interp, argv[i]+1, &buffer); - } else { - if (!noComplain) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "globbing characters not ", - "supported in user names", (char *) NULL); - } - head = NULL; - } - *tail = c; - if (head == NULL) { - if (noComplain) { - Tcl_ResetResult(interp); - continue; - } else { - result = TCL_ERROR; - goto done; - } - } - if (head != Tcl_DStringValue(&buffer)) { - Tcl_DStringAppend(&buffer, head, -1); - } + /* + * Determine the home directory for the specified user. Note that + * we don't allow special characters in the user name. + */ + + c = *tail; + *tail = '\0'; + p = strpbrk(pattern+1, "\\[]*?{}"); + if (p == NULL) { + head = DoTildeSubst(interp, pattern+1, &buffer); } else { - tail = argv[i]; + if (!noComplain) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "globbing characters not ", + "supported in user names", (char *) NULL); + } + head = NULL; } - - result = TclDoGlob(interp, separators, &buffer, tail); - if (result != TCL_OK) { + *tail = c; + if (head == NULL) { if (noComplain) { /* * We should in fact pass down the nocomplain flag - * or save the interp result or use another mecanism + * or save the interp result or use another mechanism * so the interp result is not mangled on errors in that case. * but that would a bigger change than reasonable for a patch * release. * (see fileName.test 15.2-15.4 for expected behaviour) */ Tcl_ResetResult(interp); - result = TCL_OK; - continue; + return TCL_OK; } else { - goto done; + return TCL_ERROR; } } + if (head != Tcl_DStringValue(&buffer)) { + Tcl_DStringAppend(&buffer, head, -1); + } + } else { + tail = pattern; } - if ((*interp->result == 0) && !noComplain) { - char *sep = ""; - - Tcl_AppendResult(interp, "no files matched glob pattern", - (argc == 2) ? " \"" : "s \"", (char *) NULL); - for (i = firstArg; i < argc; i++) { - Tcl_AppendResult(interp, sep, argv[i], (char *) NULL); - sep = " "; + result = TclDoGlob(interp, separators, &buffer, tail); + Tcl_DStringFree(&buffer); + if (result != TCL_OK) { + if (noComplain) { + Tcl_ResetResult(interp); + return TCL_OK; } - Tcl_AppendResult(interp, "\"", (char *) NULL); - result = TCL_ERROR; } -done: - Tcl_DStringFree(&buffer); return result; } @@ -1339,11 +1436,12 @@ TclDoGlob(interp, separators, headPtr, tail) * that should be used to identify globbing * boundaries. */ Tcl_DString *headPtr; /* Completely expanded prefix. */ - char *tail; /* The unexpanded remainder of the path. */ + char *tail; /* The unexpanded remainder of the path. + * Must not be a pointer to a static string. */ { int baseLength, quoted, count; int result = TCL_OK; - char *p, *openBrace, *closeBrace, *name, *firstSpecialChar, savedChar; + char *name, *p, *openBrace, *closeBrace, *firstSpecialChar, savedChar; char lastChar = 0; int length = Tcl_DStringLength(headPtr); @@ -1515,6 +1613,12 @@ TclDoGlob(interp, separators, headPtr, tail) */ if (*p != '\0') { + + /* + * Note that we are modifying the string in place. This won't work + * if the string is a static. + */ + savedChar = *p; *p = '\0'; firstSpecialChar = strpbrk(tail, "*[]?\\"); @@ -1528,11 +1632,11 @@ TclDoGlob(interp, separators, headPtr, tail) * Look for matching files in the current directory. The * implementation of this function is platform specific, but may * recursively call TclDoGlob. For each file that matches, it will - * add the match onto the interp->result, or call TclDoGlob if there + * add the match onto the interp's result, or call TclDoGlob if there * are more characters to be processed. */ - return TclMatchFiles(interp, separators, headPtr, tail, p); + return TclpMatchFiles(interp, separators, headPtr, tail, p); } Tcl_DStringAppend(headPtr, tail, p-tail); if (*p != '\0') { @@ -1546,21 +1650,23 @@ TclDoGlob(interp, separators, headPtr, tail) */ switch (tclPlatform) { - case TCL_PLATFORM_MAC: + case TCL_PLATFORM_MAC: { if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) { Tcl_DStringAppend(headPtr, ":", 1); } name = Tcl_DStringValue(headPtr); - if (TclAccess(name, F_OK) == 0) { + if (TclpAccess(name, F_OK) == 0) { if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) { - Tcl_AppendElement(interp, name+1); + Tcl_AppendElement(interp, name + 1); } else { Tcl_AppendElement(interp, name); } } break; + } case TCL_PLATFORM_WINDOWS: { int exists; + /* * We need to convert slashes to backslashes before checking * for the existence of the file. Once we are done, we need @@ -1582,7 +1688,8 @@ TclDoGlob(interp, separators, headPtr, tail) } } name = Tcl_DStringValue(headPtr); - exists = (TclAccess(name, F_OK) == 0); + exists = (TclpAccess(name, F_OK) == 0); + for (p = name; *p != '\0'; p++) { if (*p == '\\') { *p = '/'; @@ -1593,7 +1700,7 @@ TclDoGlob(interp, separators, headPtr, tail) } break; } - case TCL_PLATFORM_UNIX: + case TCL_PLATFORM_UNIX: { if (Tcl_DStringLength(headPtr) == 0) { if ((*name == '\\' && name[1] == '/') || (*name == '/')) { Tcl_DStringAppend(headPtr, "/", 1); @@ -1602,10 +1709,11 @@ TclDoGlob(interp, separators, headPtr, tail) } } name = Tcl_DStringValue(headPtr); - if (TclAccess(name, F_OK) == 0) { + if (TclpAccess(name, F_OK) == 0) { Tcl_AppendElement(interp, name); } break; + } } return TCL_OK; |