summaryrefslogtreecommitdiffstats
path: root/generic/tclFileName.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclFileName.c')
-rw-r--r--generic/tclFileName.c413
1 files changed, 214 insertions, 199 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index ec865e1..785769a 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.58 2004/10/06 15:20:48 dkf Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.59 2004/10/06 23:44:06 dkf Exp $
*/
#include "tclInt.h"
@@ -37,8 +37,9 @@ static int SkipToChar _ANSI_ARGS_((char **stringPtr, int match));
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));
+ Tcl_Obj *resultPtr, char *separators,
+ Tcl_Obj *pathPtr, int flags, char *pattern,
+ Tcl_GlobTypeData *types));
/*
@@ -1363,9 +1364,10 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
* made use of it.
*/
badTypesArg:
- resultPtr = Tcl_GetObjResult(interp);
+ TclNewObj(resultPtr);
Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
Tcl_AppendObjToObj(resultPtr, look);
+ Tcl_SetObjResult(interp, resultPtr);
result = TCL_ERROR;
join = 0;
goto endOfGlob;
@@ -1530,7 +1532,7 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
CONST char *head;
char *tail, *start;
int result;
- Tcl_Obj *oldResult;
+ Tcl_Obj *filenamesObj, *savedResultObj;
separators = NULL; /* lint. */
switch (tclPlatform) {
@@ -1619,6 +1621,7 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
* Similarly on Unix with '/' at the head of the pattern -- it
* just indicates the root volume, so we treat it as such.
*/
+
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
if (pathPrefix == NULL && tail[0] != '\0' && tail[1] == ':') {
char *p = tail + 1;
@@ -1712,6 +1715,7 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
* Finally if we still haven't managed to generate a path
* prefix, check if the path starts with a current volume.
*/
+
if (pathPrefix == NULL) {
int driveNameLen;
Tcl_Obj *driveName;
@@ -1723,97 +1727,114 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
}
/*
- * We need to get the old result, in case it is over-written
- * below when we still need it.
+ * To process a [glob] invokation, this function may be called
+ * multiple times. Each time, the previously discovered filenames
+ * are in the interpreter result. We stash that away here so the
+ * result is free for error messsages.
*/
- oldResult = Tcl_GetObjResult(interp);
- Tcl_IncrRefCount(oldResult);
+
+ savedResultObj = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(savedResultObj);
Tcl_ResetResult(interp);
+ TclNewObj(filenamesObj);
+
+ /*
+ * Now we do the actual globbing, adding filenames as we go to
+ * buffer in filenamesObj
+ */
if (*tail == '\0' && pathPrefix != NULL) {
/*
* An empty pattern
*/
- result = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp),
- pathPrefix, NULL, types);
-
+ result = Tcl_FSMatchInDirectory(interp, filenamesObj, pathPrefix,
+ NULL, types);
} else {
- result = DoGlob(interp, separators, pathPrefix,
+ result = DoGlob(interp, filenamesObj, separators, pathPrefix,
globFlags & TCL_GLOBMODE_DIR, tail, types);
}
+ /*
+ * Check for errors...
+ */
+
if (result != TCL_OK) {
+ TclDecrRefCount(filenamesObj);
if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
/* Put back the old result and reset the return code */
- Tcl_SetObjResult(interp, oldResult);
+ Tcl_SetObjResult(interp, savedResultObj);
result = TCL_OK;
}
- } else {
- /*
- * Now we must concatenate the 'oldResult' and the current
- * result, and then place that into the interpreter.
- *
- * 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
- * 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.
- */
+ TclDecrRefCount(savedResultObj);
+ return result;
+ }
- /*
- * 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);
- }
+ /*
+ * 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
+ * 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.
+ *
+ * We do it by rewriting the result list in-place.
+ */
- if (globFlags & TCL_GLOBMODE_TAILS) {
- int objc, i;
- Tcl_Obj **objv;
- int prefixLen;
+ 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++;
- }
+ /* 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++;
}
+ }
- Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp),
- &objc, &objv);
- for (i = 0; i< objc; i++) {
- Tcl_Obj* elt;
- int len;
- char *oldStr = Tcl_GetStringFromObj(objv[i],&len);
- if (len == prefixLen) {
- if ((pattern[0] == '\0')
- || (strchr(separators, pattern[0]) == NULL)) {
- elt = Tcl_NewStringObj(".",1);
- } else {
- elt = Tcl_NewStringObj("/",1);
- }
+ Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
+ for (i = 0; i< objc; i++) {
+ int len;
+ char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
+ Tcl_Obj* elems[1];
+
+ if (len == prefixLen) {
+ if ((pattern[0] == '\0')
+ || (strchr(separators, pattern[0]) == NULL)) {
+ elems[0] = Tcl_NewStringObj(".", 1);
} else {
- elt = Tcl_NewStringObj(oldStr + prefixLen,
- len - prefixLen);
+ elems[0] = Tcl_NewStringObj("/", 1);
}
- Tcl_ListObjAppendElement(interp, oldResult, elt);
+ } else {
+ elems[0] = Tcl_NewStringObj(oldStr + prefixLen,
+ len - prefixLen);
}
- } else {
- Tcl_ListObjAppendList(interp, oldResult, Tcl_GetObjResult(interp));
+ Tcl_ListObjReplace(interp, filenamesObj, i, 1, 1, elems);
}
- Tcl_SetObjResult(interp, oldResult);
}
+
/*
- * Release our temporary copy. All code paths above must
- * end here so we free our reference.
+ * Now we have a list of discovered filenames in filenamesObj and
+ * a list of previously discovered (saved earlier from the
+ * interpreter result) in savedResultObj. Merge them and put them
+ * back in the interpreter result.
*/
- Tcl_DecrRefCount(oldResult);
+
+ if (Tcl_IsShared(savedResultObj)) {
+ TclDecrRefCount(savedResultObj);
+ savedResultObj = Tcl_DuplicateObj(savedResultObj);
+ Tcl_IncrRefCount(savedResultObj);
+ }
+ if (Tcl_ListObjAppendList(interp, savedResultObj, filenamesObj) != TCL_OK){
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, savedResultObj);
+ }
+ TclDecrRefCount(savedResultObj);
+ TclDecrRefCount(filenamesObj);
+
return result;
}
@@ -1898,9 +1919,13 @@ SkipToChar(stringPtr, match)
*/
static int
-DoGlob(interp, separators, pathPtr, flags, pattern, types)
+DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
Tcl_Interp *interp; /* Interpreter to use for error reporting
* (e.g. unmatched brace). */
+ Tcl_Obj *matchesObj; /* Unshared list object in which to place all
+ * resulting filenames. Caller allocates and
+ * deallocates; DoGlob must not touch the
+ * refCount of this object. */
char *separators; /* String containing separator characters
* that should be used to identify globbing
* boundaries. */
@@ -1915,6 +1940,7 @@ DoGlob(interp, separators, pathPtr, flags, pattern, types)
int baseLength, quoted, count;
int result = TCL_OK;
char *name, *p, *openBrace, *closeBrace, *firstSpecialChar;
+ Tcl_Obj *joinedPtr;
/*
* Consume any leading directory separators, leaving pattern pointing
@@ -1950,7 +1976,7 @@ DoGlob(interp, separators, pathPtr, flags, pattern, types)
* elsewhere. It is left in place in case new bugs are reported
*/
-#if 0
+#if 0 /* PROBABLY_OBSOLETE */
/*
* Deal with path separators.
*/
@@ -2001,7 +2027,7 @@ DoGlob(interp, separators, pathPtr, flags, pattern, types)
break;
}
}
-#endif
+#endif /* PROBABLY_OBSOLETE */
/*
* Look for the first matching pair of braces or the first
@@ -2053,7 +2079,7 @@ DoGlob(interp, separators, pathPtr, flags, pattern, types)
/*
* For each element within in the outermost pair of braces,
* append the element and the remainder to the fixed portion
- * before the first brace and recursively call TclDoGlob.
+ * before the first brace and recursively call DoGlob.
*/
Tcl_DStringAppend(&newName, pattern, openBrace-pattern);
@@ -2066,7 +2092,7 @@ DoGlob(interp, separators, pathPtr, flags, pattern, types)
Tcl_DStringSetLength(&newName, baseLength);
Tcl_DStringAppend(&newName, element, p-element);
Tcl_DStringAppend(&newName, closeBrace+1, -1);
- result = DoGlob(interp, separators, pathPtr, flags,
+ result = DoGlob(interp, matchesObj, separators, pathPtr, flags,
Tcl_DStringValue(&newName), types);
if (result != TCL_OK) {
break;
@@ -2096,7 +2122,6 @@ DoGlob(interp, separators, pathPtr, flags, pattern, types)
*/
if (*p != '\0') {
-
/*
* Note that we are modifying the string in place. This won't work
* if the string is a static.
@@ -2111,156 +2136,146 @@ DoGlob(interp, separators, pathPtr, flags, pattern, types)
}
if (firstSpecialChar != NULL) {
- int ret;
-
/*
* Look for matching files in the given directory. The
* 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),
- pathPtr, pattern, types);
- } else {
- Tcl_Obj* resultPtr;
- /*
- * We do the recursion ourselves. This makes implementing
- * Tcl_FSMatchInDirectory for each filesystem much easier.
- */
- Tcl_GlobTypeData dirOnly = { TCL_GLOB_TYPE_DIR, 0, NULL, NULL };
- char save = *p;
-
- *p = '\0';
- resultPtr = Tcl_NewListObj(0, NULL);
- ret = Tcl_FSMatchInDirectory(interp, resultPtr,
- pathPtr, pattern, &dirOnly);
- *p = save;
- if (ret == TCL_OK) {
- int resLength;
- ret = Tcl_ListObjLength(interp, resultPtr, &resLength);
- if (ret == TCL_OK) {
- int i;
- for (i =0; i< resLength; i++) {
- Tcl_Obj *elt;
-
- Tcl_ListObjIndex(interp, resultPtr, i, &elt);
- ret = DoGlob(interp, separators, elt, 1, p+1, types);
- if (ret != TCL_OK) {
- break;
- }
- }
- }
- }
- Tcl_DecrRefCount(resultPtr);
+ static Tcl_GlobTypeData dirOnly = {
+ TCL_GLOB_TYPE_DIR, 0, NULL, NULL
+ };
+ char save = *p;
+ Tcl_Obj* subdirsPtr;
+
+ if (*p == '\0') {
+ return Tcl_FSMatchInDirectory(interp, matchesObj, pathPtr,
+ pattern, types);
}
- return ret;
- } else {
+
/*
- * We reach here with no pattern char in current section
+ * We do the recursion ourselves. This makes implementing
+ * Tcl_FSMatchInDirectory for each filesystem much easier.
*/
- 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);
+ *p = '\0';
+ TclNewObj(subdirsPtr);
+ result = Tcl_FSMatchInDirectory(interp, subdirsPtr, pathPtr,
+ pattern, &dirOnly);
+ *p = save;
+ if (result == TCL_OK) {
+ int subdirc, i;
+ Tcl_Obj **subdirv;
+
+ result = Tcl_ListObjGetElements(interp, subdirsPtr,
+ &subdirc, &subdirv);
+ for (i=0; result==TCL_OK && i<subdirc; i++) {
+ result = DoGlob(interp, matchesObj, separators, subdirv[i],
+ 1, p+1, types);
}
- 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).
- */
+ }
+ TclDecrRefCount(subdirsPtr);
+ return result;
+ }
- Tcl_Obj *joined;
- int length;
- Tcl_DString append;
+ /*
+ * We reach here with no pattern char in current section
+ */
- Tcl_DStringInit(&append);
- Tcl_DStringAppend(&append, pattern, p-pattern);
+ if (*p == '\0') {
+ /*
+ * 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).
+ */
- if (pathPtr != NULL) {
- Tcl_GetStringFromObj(pathPtr, &length);
- } else {
- length = 0;
- }
+ int length;
+ Tcl_DString append;
- switch (tclPlatform) {
- 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);
- }
+ Tcl_DStringInit(&append);
+ Tcl_DStringAppend(&append, pattern, p-pattern);
+
+ if (pathPtr != NULL) {
+ (void) Tcl_GetStringFromObj(pathPtr, &length);
+ } else {
+ length = 0;
+ }
+
+ switch (tclPlatform) {
+ 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(CONST char *, char *);
- char winbuf[MAX_PATH+1];
+ {
+ extern int cygwin_conv_to_win32_path(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;
- 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;
+ cygwin_conv_to_win32_path(Tcl_DStringValue(&append), winbuf);
+ Tcl_DStringFree(&append);
+ Tcl_DStringAppend(&append, winbuf, -1);
}
- /* Common for all platforms */
- if (pathPtr != NULL) {
- if (flags) {
- joined = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
- Tcl_DStringLength(&append));
+#endif /* __CYGWIN__ && __WIN32__ */
+ break;
+ case TCL_PLATFORM_UNIX:
+ if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
+ if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
+ Tcl_DStringAppend(&append, "/", 1);
} else {
- joined = Tcl_DuplicateObj(pathPtr);
- Tcl_AppendToObj(joined, Tcl_DStringValue(&append),
- Tcl_DStringLength(&append));
+ Tcl_DStringAppend(&append, ".", 1);
}
- } 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;
+ break;
+ }
+ /* Common for all platforms */
+ if (pathPtr == NULL) {
+ joinedPtr = Tcl_NewStringObj(Tcl_DStringValue(&append),
+ Tcl_DStringLength(&append));
+ } else if (flags) {
+ joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
+ Tcl_DStringLength(&append));
+ } else {
+ joinedPtr = Tcl_DuplicateObj(pathPtr);
+ Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append),
+ Tcl_DStringLength(&append));
}
+ Tcl_IncrRefCount(joinedPtr);
+ Tcl_DStringFree(&append);
+ Tcl_FSMatchInDirectory(interp, matchesObj, joinedPtr, NULL, types);
+ Tcl_DecrRefCount(joinedPtr);
+ return TCL_OK;
}
+
+ /*
+ * If it's not the end of the string, we must recurse
+ */
+
+ if (pathPtr == NULL) {
+ joinedPtr = Tcl_NewStringObj(pattern, p-pattern);
+ } else if (flags) {
+ joinedPtr = TclNewFSPathObj(pathPtr, pattern, p-pattern);
+ } else {
+ joinedPtr = Tcl_DuplicateObj(pathPtr);
+ Tcl_AppendToObj(joinedPtr, pattern, p-pattern);
+ }
+
+ Tcl_IncrRefCount(joinedPtr);
+ result = DoGlob(interp, matchesObj, separators, joinedPtr, 1, p, types);
+ Tcl_DecrRefCount(joinedPtr);
+
+ return result;
}
/*