summaryrefslogtreecommitdiffstats
path: root/generic/tclFileName.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclFileName.c')
-rw-r--r--generic/tclFileName.c810
1 files changed, 436 insertions, 374 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 52ebfd8..54c11cc 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -10,7 +10,7 @@
* 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.45 2004/01/13 17:13:01 dgp Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.46 2004/01/21 19:59:33 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -75,11 +75,15 @@ static CONST char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
static CONST char * ExtractWinRoot _ANSI_ARGS_((CONST char *path,
Tcl_DString *resultPtr, int offset,
Tcl_PathType *typePtr));
-static int SkipToChar _ANSI_ARGS_((char **stringPtr,
- char *match));
+static int SkipToChar _ANSI_ARGS_((CONST char **stringPtr,
+ char match));
static Tcl_Obj* SplitMacPath _ANSI_ARGS_((CONST char *path));
static Tcl_Obj* SplitWinPath _ANSI_ARGS_((CONST char *path));
static Tcl_Obj* SplitUnixPath _ANSI_ARGS_((CONST char *path));
+static int DoGlob _ANSI_ARGS_((Tcl_Interp *interp,
+ char *separators, Tcl_Obj *pathPtr,
+ int flags, char *pattern, Tcl_GlobTypeData *types));
+
#ifdef MAC_UNDERSTANDS_UNIX_PATHS
/*
@@ -347,14 +351,15 @@ Tcl_GetPathType(path)
*/
Tcl_PathType
-TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef)
- Tcl_Obj *pathObjPtr;
- int *driveNameLengthPtr;
- Tcl_Obj **driveNameRef;
+TclpGetNativePathType(pathPtr, driveNameLengthPtr, driveNameRef)
+ Tcl_Obj *pathPtr; /* Native path of interest */
+ int *driveNameLengthPtr; /* Returns length of drive, if non-NULL
+ * and path was absolute */
+ Tcl_Obj **driveNameRef;
{
Tcl_PathType type = TCL_PATH_ABSOLUTE;
int pathLen;
- char *path = Tcl_GetStringFromObj(pathObjPtr, &pathLen);
+ char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
if (path[0] == '~') {
/*
@@ -611,6 +616,7 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
tmpPtr = Tcl_NewStringObj(path, -1);
Tcl_IncrRefCount(tmpPtr);
resultPtr = Tcl_FSSplitPath(tmpPtr, argcPtr);
+ Tcl_IncrRefCount(resultPtr);
Tcl_DecrRefCount(tmpPtr);
/* Calculate space required for the result */
@@ -1055,9 +1061,15 @@ SplitMacPath(path)
* This function takes the given object, which should usually be a
* valid path or NULL, and joins onto it the array of paths
* segments given.
- *
+ *
+ * The objects in the array given will temporarily have their
+ * refCount increased by one, and then decreased by one when this
+ * function exits (which means if they had zero refCount when we
+ * were called, they will be freed).
+ *
* Results:
- * Returns object with refCount of zero
+ * Returns object owned by the caller (which should increment its
+ * refCount) - typically an object with refCount of zero.
*
* Side effects:
* None.
@@ -1066,25 +1078,35 @@ SplitMacPath(path)
*/
Tcl_Obj*
-Tcl_FSJoinToPath(basePtr, objc, objv)
- Tcl_Obj *basePtr;
- int objc;
- Tcl_Obj *CONST objv[];
+Tcl_FSJoinToPath(pathPtr, objc, objv)
+ Tcl_Obj *pathPtr; /* Valid path or NULL. */
+ int objc; /* Number of array elements to join */
+ Tcl_Obj *CONST objv[]; /* Path elements to join. */
{
int i;
Tcl_Obj *lobj, *ret;
- if (basePtr == NULL) {
+ if (pathPtr == NULL) {
lobj = Tcl_NewListObj(0, NULL);
} else {
- lobj = Tcl_NewListObj(1, &basePtr);
+ lobj = Tcl_NewListObj(1, &pathPtr);
}
for (i = 0; i<objc;i++) {
Tcl_ListObjAppendElement(NULL, lobj, objv[i]);
}
ret = Tcl_FSJoinPath(lobj, -1);
+ /*
+ * It is possible that 'ret' is just a member of the list and is
+ * therefore going to be freed here. Therefore we must adjust the
+ * refCount manually. (It would be better if we changed the
+ * documentation of this function and Tcl_FSJoinPath so that
+ * the returned object already has a refCount for the caller,
+ * hence avoiding these subtleties (and code ugliness)).
+ */
+ Tcl_IncrRefCount(ret);
Tcl_DecrRefCount(lobj);
+ ret->refCount--;
return ret;
}
@@ -1428,11 +1450,11 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
TclGetExtension(name)
- char *name; /* File name to parse. */
+ CONST char *name; /* File name to parse. */
{
- char *p, *lastSep;
+ CONST char *p, *lastSep;
/*
* First find the last directory separator.
@@ -1710,8 +1732,15 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
char *search, *find;
Tcl_DStringInit(&pref);
if (last == first) {
- /* The whole thing is a prefix */
+ /*
+ * The whole thing is a prefix. This means we must
+ * remove any 'tails' flag too, since it is irrelevant
+ * now (the same effect will happen without it), but in
+ * particular its use in TclGlob requires a non-NULL
+ * pathOrDir.
+ */
Tcl_DStringAppend(&pref, first, -1);
+ globFlags &= ~TCL_GLOBMODE_TAILS;
pathOrDir = NULL;
} else {
/* Have to split off the end */
@@ -1957,20 +1986,24 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
*
* TclGlob --
*
- * This procedure prepares arguments for the TclDoGlob call.
+ * This procedure prepares arguments for the DoGlob call.
* It sets the separator string based on the platform, performs
- * tilde substitution, and calls TclDoGlob.
+ * tilde substitution, and calls DoGlob.
*
* The interpreter's result, on entry to this function, must
* be a valid Tcl list (e.g. it could be empty), since we will
* lappend any new results to that list. If it is not a valid
* list, this function will fail to do anything very meaningful.
+ *
+ * Note that if globFlags contains 'TCL_GLOBMODE_TAILS' then
+ * pathPrefix cannot be NULL (it is only allowed with -dir or
+ * -path).
*
* 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 pattern and unquotedPrefix arguments. After an
+ * result in interp (set by DoGlob) holds all of the file names
+ * given by the pattern and pathPrefix arguments. After an
* error the result in interp will hold an error message, unless
* the 'TCL_GLOBMODE_NO_COMPLAIN' flag was given, in which case
* an error results in a TCL_OK return leaving the interpreter's
@@ -1984,13 +2017,13 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
+TclGlob(interp, pattern, pathPrefix, globFlags, types)
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. */
- Tcl_Obj *unquotedPrefix; /* Prefix to glob pattern, if non-null, which
- * is considered literally. */
+ Tcl_Obj *pathPrefix; /* Path prefix to glob pattern, if non-null,
+ * which is considered literally. */
int globFlags; /* Stores or'ed combination of flags */
Tcl_GlobTypeData *types; /* Struct containing acceptable types.
* May be NULL. */
@@ -1998,11 +2031,9 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
char *separators;
CONST char *head;
char *tail, *start;
- char c;
- int result, prefixLen;
- Tcl_DString buffer;
+ int result;
Tcl_Obj *oldResult;
-
+
separators = NULL; /* lint. */
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
@@ -2013,7 +2044,7 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
break;
case TCL_PLATFORM_MAC:
#ifdef MAC_UNDERSTANDS_UNIX_PATHS
- if (unquotedPrefix == NULL) {
+ if (pathPrefix == NULL) {
separators = (strchr(pattern, ':') == NULL) ? "/" : ":";
} else {
separators = ":";
@@ -2024,91 +2055,120 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
break;
}
- Tcl_DStringInit(&buffer);
- if (unquotedPrefix != NULL) {
- start = Tcl_GetString(unquotedPrefix);
- } else {
- start = pattern;
- }
-
- /*
- * Perform tilde substitution, if needed.
- */
+ if (pathPrefix == NULL) {
+ char c;
+ Tcl_DString buffer;
+ Tcl_DStringInit(&buffer);
- if (start[0] == '~') {
-
+ start = pattern;
/*
- * Find the first path separator after the tilde.
+ * Perform tilde substitution, if needed.
*/
- for (tail = start; *tail != '\0'; tail++) {
- if (*tail == '\\') {
- if (strchr(separators, tail[1]) != NULL) {
+
+ if (start[0] == '~') {
+
+ /*
+ * 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;
}
- } else if (strchr(separators, *tail) != NULL) {
- break;
}
- }
- /*
- * Determine the home directory for the specified user.
- */
-
- c = *tail;
- *tail = '\0';
- if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
- /*
- * We will ignore any error message here, and we
- * don't want to mess up the interpreter's result.
+ /*
+ * Determine the home directory for the specified user.
*/
- head = DoTildeSubst(NULL, start+1, &buffer);
- } else {
- head = DoTildeSubst(interp, start+1, &buffer);
- }
- *tail = c;
- if (head == NULL) {
+
+ c = *tail;
+ *tail = '\0';
if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
- return TCL_OK;
+ /*
+ * We will ignore any error message here, and we
+ * don't want to mess up the interpreter's result.
+ */
+ head = DoTildeSubst(NULL, start+1, &buffer);
} else {
- return TCL_ERROR;
+ head = DoTildeSubst(interp, start+1, &buffer);
}
- }
- if (head != Tcl_DStringValue(&buffer)) {
- Tcl_DStringAppend(&buffer, head, -1);
- }
- if (unquotedPrefix != NULL) {
- Tcl_DStringAppend(&buffer, tail, -1);
+ *tail = c;
+ if (head == NULL) {
+ if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
+ return TCL_OK;
+ } else {
+ return TCL_ERROR;
+ }
+ }
+ if (head != Tcl_DStringValue(&buffer)) {
+ Tcl_DStringAppend(&buffer, head, -1);
+ }
+ pathPrefix = Tcl_NewStringObj(Tcl_DStringValue(&buffer),
+ Tcl_DStringLength(&buffer));
+ Tcl_IncrRefCount(pathPrefix);
+ globFlags |= TCL_GLOBMODE_DIR;
+ if (c != '\0') {
+ tail++;
+ }
+ Tcl_DStringFree(&buffer);
+ } else {
tail = pattern;
}
} else {
+ Tcl_IncrRefCount(pathPrefix);
tail = pattern;
- if (unquotedPrefix != NULL) {
- Tcl_DStringAppend(&buffer,Tcl_GetString(unquotedPrefix),-1);
- }
}
/*
- * We want to remember the length of the current prefix,
- * in case we are using TCL_GLOBMODE_TAILS. Also if we
- * are using TCL_GLOBMODE_DIR, we must make sure the
- * prefix ends in a directory separator.
+ * Handling empty path prefixes with glob patterns like 'C:' or
+ * 'c:////////' is a pain on Windows if we leave it too late, since
+ * these aren't really patterns at all! We therefore check the head
+ * of the pattern now for such cases, if we don't have an unquoted
+ * prefix yet.
+ *
+ * Similarly on Unix with '/' at the head of the pattern -- it
+ * just indicates the root volume, so we treat it as such.
*/
- prefixLen = Tcl_DStringLength(&buffer);
-
- if (prefixLen > 0) {
- c = Tcl_DStringValue(&buffer)[prefixLen-1];
- if (strchr(separators, c) == NULL) {
- /*
- * If the prefix is a directory, make sure it ends in a
- * directory separator.
- */
- if (globFlags & TCL_GLOBMODE_DIR) {
- Tcl_DStringAppend(&buffer,separators,1);
+ if (tclPlatform == TCL_PLATFORM_WINDOWS) {
+ if (pathPrefix == NULL && tail[0] != '\0' && tail[1] == ':') {
+ char *p = tail + 1;
+ pathPrefix = Tcl_NewStringObj(tail, 1);
+ while (*p != '\0') {
+ char c = p[1];
+ if (*p == '\\') {
+ if (strchr(separators, c) != NULL) {
+ if (c == '\\') c = '/';
+ Tcl_AppendToObj(pathPrefix, &c, 1);
+ p++;
+ } else {
+ break;
+ }
+ } else if (strchr(separators, *p) != NULL) {
+ Tcl_AppendToObj(pathPrefix, p, 1);
+ } else {
+ break;
+ }
+ p++;
}
- prefixLen++;
+ tail = p;
+ Tcl_IncrRefCount(pathPrefix);
+ }
+ /*
+ * ':' no longer needed as a separator. It is only relevant
+ * to the beginning of the path.
+ */
+ separators = "/\\";
+ } else if (tclPlatform == TCL_PLATFORM_UNIX) {
+ if (pathPrefix == NULL && tail[0] == '/') {
+ pathPrefix = Tcl_NewStringObj(tail, 1);
+ tail++;
+ Tcl_IncrRefCount(pathPrefix);
}
}
-
+
/*
* We need to get the old result, in case it is over-written
* below when we still need it.
@@ -2116,8 +2176,18 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
oldResult = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(oldResult);
Tcl_ResetResult(interp);
-
- result = TclDoGlob(interp, separators, &buffer, tail, types);
+
+ if (*tail == '\0' && pathPrefix != NULL) {
+ /*
+ * An empty pattern
+ */
+ result = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp),
+ pathPrefix, NULL, types);
+
+ } else {
+ result = DoGlob(interp, separators, pathPrefix,
+ globFlags & TCL_GLOBMODE_DIR, tail, types);
+ }
if (result != TCL_OK) {
if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
@@ -2132,37 +2202,49 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
*
* If we only want the tails, we must strip off the prefix now.
* It may seem more efficient to pass the tails flag down into
- * TclDoGlob, Tcl_FSMatchInDirectory, but those functions are
+ * DoGlob, Tcl_FSMatchInDirectory, but those functions are
* continually adjusting the prefix as the various pieces of
* the pattern are assimilated, so that would add a lot of
* complexity to the code. This way is a little slower (when
* the -tails flag is given), but much simpler to code.
*/
- int objc, i;
- Tcl_Obj **objv;
- /* Ensure sole ownership */
+ /*
+ * Ensure sole ownership. We also assume that oldResult
+ * is a valid list in the code below.
+ */
if (Tcl_IsShared(oldResult)) {
Tcl_DecrRefCount(oldResult);
oldResult = Tcl_DuplicateObj(oldResult);
Tcl_IncrRefCount(oldResult);
}
- Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp),
- &objc, &objv);
-#ifdef MAC_TCL
- /* adjust prefixLen if TclDoGlob prepended a ':' */
- if ((prefixLen > 0) && (objc > 0)
- && (Tcl_DStringValue(&buffer)[0] != ':')) {
- char *str = Tcl_GetStringFromObj(objv[0],NULL);
- if (str[0] == ':') {
+ if (globFlags & TCL_GLOBMODE_TAILS) {
+ int objc, i;
+ Tcl_Obj **objv;
+ int prefixLen;
+
+ /* If this length has never been set, set it here */
+ CONST char *pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
+ if (prefixLen > 0) {
+ if (strchr(separators, pre[prefixLen-1]) == NULL) {
prefixLen++;
+ }
}
- }
-#endif
- for (i = 0; i< objc; i++) {
- Tcl_Obj* elt;
- if (globFlags & TCL_GLOBMODE_TAILS) {
+
+ Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp),
+ &objc, &objv);
+ #ifdef MAC_TCL
+ /* adjust prefixLen if DoGlob prepended a ':' */
+ if ((prefixLen > 0) && (objc > 0) && (pre[0] != ':')) {
+ CONST char *str = Tcl_GetStringFromObj(objv[0],NULL);
+ if (str[0] == ':') {
+ prefixLen++;
+ }
+ }
+ #endif
+ for (i = 0; i< objc; i++) {
+ Tcl_Obj* elt;
int len;
char *oldStr = Tcl_GetStringFromObj(objv[i],&len);
if (len == prefixLen) {
@@ -2176,11 +2258,10 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
elt = Tcl_NewStringObj(oldStr + prefixLen,
len - prefixLen);
}
- } else {
- elt = objv[i];
+ Tcl_ListObjAppendElement(interp, oldResult, elt);
}
- /* Assumption that 'oldResult' is a valid list */
- Tcl_ListObjAppendElement(interp, oldResult, elt);
+ } else {
+ Tcl_ListObjAppendList(interp, oldResult, Tcl_GetObjResult(interp));
}
Tcl_SetObjResult(interp, oldResult);
}
@@ -2189,7 +2270,6 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
* end here so we free our reference.
*/
Tcl_DecrRefCount(oldResult);
- Tcl_DStringFree(&buffer);
return result;
}
@@ -2215,11 +2295,11 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
static int
SkipToChar(stringPtr, match)
- char **stringPtr; /* Pointer string to check. */
- char *match; /* Pointer to character to find. */
+ CONST char **stringPtr; /* Pointer string to check. */
+ char match; /* Pointer to character to find. */
{
int quoted, level;
- register char *p;
+ register CONST char *p;
quoted = 0;
level = 0;
@@ -2229,7 +2309,7 @@ SkipToChar(stringPtr, match)
quoted = 0;
continue;
}
- if ((level == 0) && (*p == *match)) {
+ if ((level == 0) && (*p == match)) {
*stringPtr = p;
return 1;
}
@@ -2248,22 +2328,20 @@ SkipToChar(stringPtr, match)
/*
*----------------------------------------------------------------------
*
- * TclDoGlob --
- *
- * This recursive procedure forms the heart of the globbing
- * code. It performs a depth-first traversal of the tree
- * given by the path name to be globbed. The directory and
- * remainder are assumed to be native format paths. The prefix
- * contained in 'headPtr' is not used as a glob pattern, simply
- * as a path specifier, so it can contain unquoted glob-sensitive
- * characters (if the directories to which it points contain
- * such strange characters).
+ * DoGlob --
*
+ * This recursive procedure forms the heart of the globbing code.
+ * It performs a depth-first traversal of the tree given by the
+ * path name to be globbed and the pattern. The directory and
+ * remainder are assumed to be native format paths. The prefix
+ * contained in 'pathPtr' is either a directory or path from which
+ * to start the search (or NULL).
+ *
* Results:
* The return value is a standard Tcl result indicating whether
* an error occurred in globbing. After a normal return the
* result in interp will be set to hold all of the file names
- * given by the dir and rem arguments. After an error the
+ * given by the dir and remaining arguments. After an error the
* result in interp will hold an error message.
*
* Side effects:
@@ -2272,128 +2350,142 @@ SkipToChar(stringPtr, match)
*----------------------------------------------------------------------
*/
-int
-TclDoGlob(interp, separators, headPtr, tail, types)
+static int
+DoGlob(interp, separators, pathPtr, flags, pattern, types)
Tcl_Interp *interp; /* Interpreter to use for error reporting
* (e.g. unmatched brace). */
char *separators; /* String containing separator characters
* that should be used to identify globbing
* boundaries. */
- Tcl_DString *headPtr; /* Completely expanded prefix. */
- char *tail; /* The unexpanded remainder of the path.
+ Tcl_Obj *pathPtr; /* Completely expanded prefix. */
+ int flags; /* If non-zero then pathPtr is a
+ * directory */
+ char *pattern; /* The pattern to match against.
* Must not be a pointer to a static string. */
Tcl_GlobTypeData *types; /* List object containing list of acceptable
- * types. May be NULL. */
+ * types. May be NULL. */
{
int baseLength, quoted, count;
int result = TCL_OK;
- char *name, *p, *openBrace, *closeBrace, *firstSpecialChar, savedChar;
- char lastChar = 0;
-
- int length = Tcl_DStringLength(headPtr);
-
- if (length > 0) {
- lastChar = Tcl_DStringValue(headPtr)[length-1];
- }
+ char *name, *p, *openBrace, *closeBrace, *firstSpecialChar;
/*
- * Consume any leading directory separators, leaving tail pointing
+ * Consume any leading directory separators, leaving pattern pointing
* just past the last initial separator.
*/
count = 0;
- name = tail;
- for (; *tail != '\0'; tail++) {
- if (*tail == '\\') {
+ name = pattern;
+ for (; *pattern != '\0'; pattern++) {
+ if (*pattern == '\\') {
/*
* If the first character is escaped, either we have a directory
* separator, or we have any other character. In the latter case
- * the rest of tail is a pattern, and we must break from the loop.
+ * the rest is a pattern, and we must break from the loop.
* This is particularly important on Windows where '\' is both
* the escaping character and a directory separator.
*/
- if (strchr(separators, tail[1]) != NULL) {
- tail++;
+ if (strchr(separators, pattern[1]) != NULL) {
+ pattern++;
} else {
break;
}
- } else if (strchr(separators, *tail) == NULL) {
+ } else if (strchr(separators, *pattern) == NULL) {
break;
}
count++;
}
+ /*
+ * This block of code is not exercised by the Tcl test suite as of
+ * Tcl 8.5a0. Simplifications to the calling paths suggest it may
+ * not be necessary any more, since path separators are handled
+ * elsewhere. It is left in place in case new bugs are reported
+ * (particularly on MacOS)
+ */
+
+#if 0
/*
* Deal with path separators. On the Mac, we have to watch out
* for multiple separators, since they are special in Mac-style
* paths.
*/
+ if (pathPtr == NULL) {
+ /*
+ * Length used to be the length of the prefix, and lastChar
+ * the lastChar of the prefix. But, none of this is used
+ * any more.
+ */
+ int length = 0;
+ char lastChar = 0;
- switch (tclPlatform) {
- case TCL_PLATFORM_MAC:
-#ifdef MAC_UNDERSTANDS_UNIX_PATHS
- if (*separators == '/') {
- if (((length == 0) && (count == 0))
- || ((length > 0) && (lastChar != ':'))) {
- Tcl_DStringAppend(headPtr, ":", 1);
- }
- } else {
-#endif
- if (count == 0) {
- if ((length > 0) && (lastChar != ':')) {
- Tcl_DStringAppend(headPtr, ":", 1);
+ switch (tclPlatform) {
+ case TCL_PLATFORM_MAC:
+ #ifdef MAC_UNDERSTANDS_UNIX_PATHS
+ if (*separators == '/') {
+ if (((length == 0) && (count == 0))
+ || ((length > 0) && (lastChar != ':'))) {
+ Tcl_DStringAppend(&append, ":", 1);
}
} else {
- if (lastChar == ':') {
- count--;
- }
- while (count-- > 0) {
- Tcl_DStringAppend(headPtr, ":", 1);
+ #endif
+ if (count == 0) {
+ if ((length > 0) && (lastChar != ':')) {
+ Tcl_DStringAppend(&append, ":", 1);
+ }
+ } else {
+ if (lastChar == ':') {
+ count--;
+ }
+ while (count-- > 0) {
+ Tcl_DStringAppend(&append, ":", 1);
+ }
}
+ #ifdef MAC_UNDERSTANDS_UNIX_PATHS
}
-#ifdef MAC_UNDERSTANDS_UNIX_PATHS
- }
-#endif
- break;
- case TCL_PLATFORM_WINDOWS:
- /*
- * If this is a drive relative path, add the colon and the
- * trailing slash if needed. Otherwise add the slash if
- * this is the first absolute element, or a later relative
- * element. Add an extra slash if this is a UNC path.
- */
+ #endif
+ break;
+ case TCL_PLATFORM_WINDOWS:
+ /*
+ * If this is a drive relative path, add the colon and the
+ * trailing slash if needed. Otherwise add the slash if
+ * this is the first absolute element, or a later relative
+ * element. Add an extra slash if this is a UNC path.
+ */
- if (*name == ':') {
- Tcl_DStringAppend(headPtr, ":", 1);
- if (count > 1) {
- Tcl_DStringAppend(headPtr, "/", 1);
- }
- } else if ((*tail != '\0')
- && (((length > 0)
- && (strchr(separators, lastChar) == NULL))
- || ((length == 0) && (count > 0)))) {
- Tcl_DStringAppend(headPtr, "/", 1);
- if ((length == 0) && (count > 1)) {
- Tcl_DStringAppend(headPtr, "/", 1);
+ if (*name == ':') {
+ Tcl_DStringAppend(&append, ":", 1);
+ if (count > 1) {
+ Tcl_DStringAppend(&append, "/", 1);
+ }
+ } else if ((*pattern != '\0')
+ && (((length > 0)
+ && (strchr(separators, lastChar) == NULL))
+ || ((length == 0) && (count > 0)))) {
+ Tcl_DStringAppend(&append, "/", 1);
+ if ((length == 0) && (count > 1)) {
+ Tcl_DStringAppend(&append, "/", 1);
+ }
}
- }
-
- break;
- case TCL_PLATFORM_UNIX:
- /*
- * Add a separator if this is the first absolute element, or
- * a later relative element.
- */
+
+ break;
+ case TCL_PLATFORM_UNIX:
+ /*
+ * Add a separator if this is the first absolute element, or
+ * a later relative element.
+ */
- if ((*tail != '\0')
- && (((length > 0)
- && (strchr(separators, lastChar) == NULL))
- || ((length == 0) && (count > 0)))) {
- Tcl_DStringAppend(headPtr, "/", 1);
- }
- break;
+ if ((*pattern != '\0')
+ && (((length > 0)
+ && (strchr(separators, lastChar) == NULL))
+ || ((length == 0) && (count > 0)))) {
+ Tcl_DStringAppend(&append, "/", 1);
+ }
+ break;
+ }
}
-
+#endif
+
/*
* Look for the first matching pair of braces or the first
* directory separator that is not inside a pair of braces.
@@ -2401,21 +2493,24 @@ TclDoGlob(interp, separators, headPtr, tail, types)
openBrace = closeBrace = NULL;
quoted = 0;
- for (p = tail; *p != '\0'; p++) {
+ for (p = pattern; *p != '\0'; p++) {
if (quoted) {
quoted = 0;
} else if (*p == '\\') {
quoted = 1;
if (strchr(separators, p[1]) != NULL) {
- break; /* Quoted directory separator. */
+ /* Quoted directory separator. */
+ break;
}
} else if (strchr(separators, *p) != NULL) {
- break; /* Unquoted directory separator. */
+ /* Unquoted directory separator. */
+ break;
} else if (*p == '{') {
openBrace = p;
p++;
- if (SkipToChar(&p, "}")) {
- closeBrace = p; /* Balanced braces. */
+ if (SkipToChar(&p, '}')) {
+ /* Balanced braces. */
+ closeBrace = p;
break;
}
Tcl_SetResult(interp, "unmatched open-brace in file name",
@@ -2434,6 +2529,7 @@ TclDoGlob(interp, separators, headPtr, tail, types)
if (openBrace != NULL) {
char *element;
+
Tcl_DString newName;
Tcl_DStringInit(&newName);
@@ -2443,20 +2539,18 @@ TclDoGlob(interp, separators, headPtr, tail, types)
* before the first brace and recursively call TclDoGlob.
*/
- Tcl_DStringAppend(&newName, tail, openBrace-tail);
+ Tcl_DStringAppend(&newName, pattern, openBrace-pattern);
baseLength = Tcl_DStringLength(&newName);
- length = Tcl_DStringLength(headPtr);
*closeBrace = '\0';
for (p = openBrace; p != closeBrace; ) {
p++;
element = p;
- SkipToChar(&p, ",");
- Tcl_DStringSetLength(headPtr, length);
+ SkipToChar(&p, ',');
Tcl_DStringSetLength(&newName, baseLength);
Tcl_DStringAppend(&newName, element, p-element);
Tcl_DStringAppend(&newName, closeBrace+1, -1);
- result = TclDoGlob(interp, separators, headPtr,
- Tcl_DStringValue(&newName), types);
+ result = DoGlob(interp, separators, pathPtr, flags,
+ Tcl_DStringValue(&newName), types);
if (result != TCL_OK) {
break;
}
@@ -2471,7 +2565,17 @@ TclDoGlob(interp, separators, headPtr, tail, types)
* this path component. The variable p is pointing at a quoted or
* unquoted directory separator or the end of the string. So we need
* to check for special globbing characters in the current pattern.
- * We avoid modifying tail if p is pointing at the end of the string.
+ * We avoid modifying pattern if p is pointing at the end of the string.
+ *
+ * If we find any globbing characters, then we must call
+ * Tcl_FSMatchInDirectory. If we're at the end of the string, then
+ * that's all we need to do. If we're not at the end of the
+ * string, then we must recurse, so we do that below.
+ *
+ * Alternatively, if there are no globbing characters then again
+ * there are two cases. If we're at the end of the string, we just
+ * need to check for the given path's existence and type. If we're
+ * not at the end of the string, we recurse.
*/
if (*p != '\0') {
@@ -2481,27 +2585,26 @@ TclDoGlob(interp, separators, headPtr, tail, types)
* if the string is a static.
*/
- savedChar = *p;
+ char savedChar = *p;
*p = '\0';
- firstSpecialChar = strpbrk(tail, "*[]?\\");
+ firstSpecialChar = strpbrk(pattern, "*[]?\\");
*p = savedChar;
} else {
- firstSpecialChar = strpbrk(tail, "*[]?\\");
+ firstSpecialChar = strpbrk(pattern, "*[]?\\");
}
if (firstSpecialChar != NULL) {
int ret;
- Tcl_Obj *head = Tcl_NewStringObj(Tcl_DStringValue(headPtr),-1);
- Tcl_IncrRefCount(head);
+
/*
* Look for matching files in the given directory. The
- * implementation of this function is platform specific. For
+ * implementation of this function is filesystem specific. For
* each file that matches, it will add the match onto the
* resultPtr given.
*/
if (*p == '\0') {
ret = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp),
- head, tail, types);
+ pathPtr, pattern, types);
} else {
Tcl_Obj* resultPtr;
@@ -2515,7 +2618,7 @@ TclDoGlob(interp, separators, headPtr, tail, types)
*p = '\0';
resultPtr = Tcl_NewListObj(0, NULL);
ret = Tcl_FSMatchInDirectory(interp, resultPtr,
- head, tail, &dirOnly);
+ pathPtr, pattern, &dirOnly);
*p = save;
if (ret == TCL_OK) {
int resLength;
@@ -2524,17 +2627,9 @@ TclDoGlob(interp, separators, headPtr, tail, types)
int i;
for (i =0; i< resLength; i++) {
Tcl_Obj *elt;
- Tcl_DString ds;
+
Tcl_ListObjIndex(interp, resultPtr, i, &elt);
- Tcl_DStringInit(&ds);
- Tcl_DStringAppend(&ds, Tcl_GetString(elt), -1);
- if(tclPlatform == TCL_PLATFORM_MAC) {
- Tcl_DStringAppend(&ds, ":",1);
- } else {
- Tcl_DStringAppend(&ds, "/",1);
- }
- ret = TclDoGlob(interp, separators, &ds, p+1, types);
- Tcl_DStringFree(&ds);
+ ret = DoGlob(interp, separators, elt, 1, p+1, types);
if (ret != TCL_OK) {
break;
}
@@ -2543,154 +2638,121 @@ TclDoGlob(interp, separators, headPtr, tail, types)
}
Tcl_DecrRefCount(resultPtr);
}
- Tcl_DecrRefCount(head);
return ret;
- }
- Tcl_DStringAppend(headPtr, tail, p-tail);
- if (*p != '\0') {
- return TclDoGlob(interp, separators, headPtr, p, types);
} else {
- /*
- * This is the code path reached by a command like 'glob foo'.
- *
- * There are no more wildcards in the pattern and no more
- * unprocessed characters in the tail, so now we can construct
- * the path, and pass it to Tcl_FSMatchInDirectory with an
- * empty pattern to verify the existence of the file and check
- * it is of the correct type (if a 'types' flag it given -- if
- * no such flag was given, we could just use 'Tcl_FSLStat', but
- * for simplicity we keep to a common approach).
+ /*
+ * We reach here with no pattern char in current section
*/
+
+ if (*p != '\0') {
+ Tcl_Obj *joined;
+ int ret;
+
+ /*
+ * If it's not the end of the string, we must recurse
+ */
+ if (pathPtr != NULL) {
+ if (flags) {
+ joined = TclNewFSPathObj(pathPtr, pattern, p-pattern);
+ } else {
+ joined = Tcl_DuplicateObj(pathPtr);
+ Tcl_AppendToObj(joined, pattern, p-pattern);
+ }
+ } else {
+ joined = Tcl_NewStringObj(pattern, p-pattern);
+ }
+ Tcl_IncrRefCount(joined);
+ ret = DoGlob(interp, separators, joined, 1, p, types);
+ Tcl_DecrRefCount(joined);
+ return ret;
+ } else {
+ /*
+ * This is the code path reached by a command like 'glob foo'.
+ *
+ * There are no more wildcards in the pattern and no more
+ * unprocessed characters in the pattern, so now we can construct
+ * the path, and pass it to Tcl_FSMatchInDirectory with an
+ * empty pattern to verify the existence of the file and check
+ * it is of the correct type (if a 'types' flag it given -- if
+ * no such flag was given, we could just use 'Tcl_FSLStat', but
+ * for simplicity we keep to a common approach).
+ */
- Tcl_Obj *nameObj;
+ Tcl_Obj *joined;
+ int length;
+ Tcl_DString append;
+
+ Tcl_DStringInit(&append);
+ Tcl_DStringAppend(&append, pattern, p-pattern);
- switch (tclPlatform) {
- case TCL_PLATFORM_MAC: {
- if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
- Tcl_DStringAppend(headPtr, ":", 1);
- }
- break;
+ if (pathPtr != NULL) {
+ Tcl_GetStringFromObj(pathPtr, &length);
+ } else {
+ length = 0;
}
- case TCL_PLATFORM_WINDOWS: {
- if (Tcl_DStringLength(headPtr) == 0) {
- if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
- || (*name == '/')) {
- Tcl_DStringAppend(headPtr, "/", 1);
- } else {
- Tcl_DStringAppend(headPtr, ".", 1);
+
+ switch (tclPlatform) {
+ case TCL_PLATFORM_MAC: {
+ if (strchr(Tcl_DStringValue(&append), ':') == NULL) {
+ Tcl_DStringAppend(&append, ":", 1);
}
+ break;
}
-#if defined(__CYGWIN__) && defined(__WIN32__)
- {
- extern int cygwin_conv_to_win32_path
- _ANSI_ARGS_((CONST char *, char *));
- char winbuf[MAX_PATH+1];
-
- cygwin_conv_to_win32_path(Tcl_DStringValue(headPtr), winbuf);
- Tcl_DStringFree(headPtr);
- Tcl_DStringAppend(headPtr, winbuf, -1);
+ case TCL_PLATFORM_WINDOWS: {
+ if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
+ if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
+ || (*name == '/')) {
+ Tcl_DStringAppend(&append, "/", 1);
+ } else {
+ Tcl_DStringAppend(&append, ".", 1);
+ }
+ }
+ #if defined(__CYGWIN__) && defined(__WIN32__)
+ {
+ extern int cygwin_conv_to_win32_path
+ _ANSI_ARGS_((CONST char *, char *));
+ char winbuf[MAX_PATH+1];
+
+ cygwin_conv_to_win32_path(Tcl_DStringValue(&append), winbuf);
+ Tcl_DStringFree(&append);
+ Tcl_DStringAppend(&append, winbuf, -1);
+ }
+ #endif /* __CYGWIN__ && __WIN32__ */
+ break;
}
-#endif /* __CYGWIN__ && __WIN32__ */
- /*
- * Convert to forward slashes. This is required to pass
- * some Tcl tests. We should probably remove the conversions
- * here and in tclWinFile.c, since they aren't needed since
- * the dropping of support for Win32s.
- */
- for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
+ case TCL_PLATFORM_UNIX: {
+ if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
+ if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
+ Tcl_DStringAppend(&append, "/", 1);
+ } else {
+ Tcl_DStringAppend(&append, ".", 1);
+ }
}
+ break;
}
- break;
}
- case TCL_PLATFORM_UNIX: {
- if (Tcl_DStringLength(headPtr) == 0) {
- if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
- Tcl_DStringAppend(headPtr, "/", 1);
- } else {
- Tcl_DStringAppend(headPtr, ".", 1);
- }
+ /* Common for all platforms */
+ if (pathPtr != NULL) {
+ if (flags) {
+ joined = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
+ Tcl_DStringLength(&append));
+ } else {
+ joined = Tcl_DuplicateObj(pathPtr);
+ Tcl_AppendToObj(joined, Tcl_DStringValue(&append),
+ Tcl_DStringLength(&append));
}
- break;
+ } else {
+ joined = Tcl_NewStringObj(Tcl_DStringValue(&append),
+ Tcl_DStringLength(&append));
}
+ Tcl_IncrRefCount(joined);
+ Tcl_DStringFree(&append);
+ Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), joined,
+ NULL, types);
+ Tcl_DecrRefCount(joined);
+ return TCL_OK;
}
- /* Common for all platforms */
- name = Tcl_DStringValue(headPtr);
- nameObj = Tcl_NewStringObj(name, Tcl_DStringLength(headPtr));
-
- Tcl_IncrRefCount(nameObj);
- Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), nameObj,
- NULL, types);
- Tcl_DecrRefCount(nameObj);
- return TCL_OK;
- }
-}
-
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclFileDirname
- *
- * This procedure calculates the directory above a given
- * path: basically 'file dirname'. It is used both by
- * the 'dirname' subcommand of file and by code in tclIOUtil.c.
- *
- * Results:
- * NULL if an error occurred, otherwise a Tcl_Obj owned by
- * the caller (i.e. most likely with refCount 1).
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-Tcl_Obj*
-TclFileDirname(interp, pathPtr)
- Tcl_Interp *interp; /* Used for error reporting */
- Tcl_Obj *pathPtr; /* Path to take dirname of */
-{
- int splitElements;
- Tcl_Obj *splitPtr;
- Tcl_Obj *splitResultPtr = NULL;
-
- /*
- * 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);
- if ((splitElements == 1) && (Tcl_GetString(pathPtr)[0] == '~')) {
- Tcl_DecrRefCount(splitPtr);
- splitPtr = Tcl_FSGetNormalizedPath(interp, pathPtr);
- if (splitPtr == NULL) {
- return NULL;
- }
- splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements);
- }
-
- /*
- * 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) {
- splitResultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1);
- } else if (splitElements == 0 ||
- (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) {
- splitResultPtr = Tcl_NewStringObj(
- ((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1);
- } else {
- Tcl_ListObjIndex(NULL, splitPtr, 0, &splitResultPtr);
}
- Tcl_IncrRefCount(splitResultPtr);
- Tcl_DecrRefCount(splitPtr);
- return splitResultPtr;
}
/*