Simplify the guts of [glob]; maybe mortals can comprehend it now?

3 files changed, 320 insertions, 309 deletions

diff --git a/ChangeLog b/ChangeLog
index 2c9315e..74d9820 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
 2004-10-06  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
+	* generic/tclFileName.c (DoGlob, TclGlob): Stop messy sharing of
+	interpreter result and instead use a private object for collecting
+	the result of the glob. This simplifies TclGlob quite a lot.
+	* generic/tclIOUtil.c (Tcl_FSMatchInDirectory): Simplify by
+	removing some nesting. Also standardize variable names.
+	(FsAddMountsToGlobResult): Force updates to the list to be done
+	in-place, putting a side-condition of non-shared-ness on the
+	resultPtr argument to Tcl_FSMatchInDirectory, but everything would
+	have broken before if that was shared *anyway*.
+
 	* generic/tclEncoding.c (LoadTableEncoding): Removed reference to
 	Tcl interpreter; it wasn't needed as direct object use is more
 	efficient.
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;
 }
 
 /*
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 1e30134..fce520e 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.109 2004/09/27 15:00:39 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.110 2004/10/06 23:44:07 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -30,15 +30,16 @@
  * Prototypes for procedures defined later in this file.
  */
 
-static FilesystemRecord*   FsGetFirstFilesystem _ANSI_ARGS_((void));
-static void                FsThrExitProc _ANSI_ARGS_((ClientData cd));
-static Tcl_Obj*            FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr, 
-					   CONST char *pattern));
-static Tcl_Obj*            FsAddMountsToGlobResult  _ANSI_ARGS_((Tcl_Obj *result, 
-	                                   Tcl_Obj *pathPtr, CONST char *pattern, 
-					   Tcl_GlobTypeData *types));
-static void                FsUpdateCwd _ANSI_ARGS_((Tcl_Obj *cwdObj, 
-					   ClientData clientData));
+static FilesystemRecord *	FsGetFirstFilesystem _ANSI_ARGS_((void));
+static void			FsThrExitProc _ANSI_ARGS_((ClientData cd));
+static Tcl_Obj*			FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr, 
+				    CONST char *pattern));
+static void			FsAddMountsToGlobResult _ANSI_ARGS_((
+				    Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
+				    CONST char *pattern, 
+				    Tcl_GlobTypeData *types));
+static void			FsUpdateCwd _ANSI_ARGS_((Tcl_Obj *cwdObj, 
+				    ClientData clientData));
 
 #ifdef TCL_THREADS
 static void FsRecacheFilesystemList(void);
@@ -1003,9 +1004,9 @@ Tcl_FSUnregister(fsPtr)
  */
 
 int
-Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
+Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
     Tcl_Interp *interp;		/* Interpreter to receive error messages. */
-    Tcl_Obj *result;		/* List object to receive results. */
+    Tcl_Obj *resultPtr;		/* List object to receive results. */
     Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
     CONST char *pattern;	/* Pattern to match against. */
     Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
@@ -1013,7 +1014,9 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
 				 * flag is very important. */
 {
     Tcl_Filesystem *fsPtr;
-    
+    Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr;
+    int resLength, i, ret = -1;
+
     if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
 	/* 
 	 * We don't currently allow querying of mounts by external code
@@ -1030,83 +1033,74 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
 	fsPtr = NULL;
     }
     
+    /*
+     * Check if we've successfully mapped the path to a filesystem
+     * within which to search.
+     */
+
     if (fsPtr != NULL) {
-	Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
-	if (proc != NULL) {
-	    int ret = (*proc)(interp, result, pathPtr, pattern, types);
-	    if (ret == TCL_OK && pattern != NULL) {
-		result = FsAddMountsToGlobResult(result, pathPtr, 
-						 pattern, types);
-	    }
-	    return ret;
+	if (fsPtr->matchInDirectoryProc == NULL) {
+	    Tcl_SetErrno(ENOENT);
+	    return -1;
 	}
-    } else {
-	Tcl_Obj* cwd;
-	int ret = -1;
-	if (pathPtr != NULL) {
-	    int len;
-	    Tcl_GetStringFromObj(pathPtr,&len);
-	    if (len != 0) {
-		/* 
-		 * We have no idea how to match files in a directory
-		 * which belongs to no known filesystem
-		 */
-		Tcl_SetErrno(ENOENT);
-		return -1;
-	    }
+	ret = (*fsPtr->matchInDirectoryProc)(interp, resultPtr, pathPtr,
+		pattern, types);
+	if (ret == TCL_OK && pattern != NULL) {
+	    FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types);
 	}
-	/* 
-	 * We have an empty or NULL path.  This is defined to mean we
-	 * must search for files within the current 'cwd'.  We
-	 * therefore use that, but then since the proc we call will
-	 * return results which include the cwd we must then trim it
-	 * off the front of each path in the result.  We choose to deal
-	 * with this here (in the generic code), since if we don't,
-	 * every single filesystem's implementation of
-	 * Tcl_FSMatchInDirectory will have to deal with it for us.
-	 */
-	cwd = Tcl_FSGetCwd(NULL);
-	if (cwd == NULL) {
-	    if (interp != NULL) {
-		Tcl_SetResult(interp, "glob couldn't determine "
-			  "the current working directory", TCL_STATIC);
-	    }
-	    return TCL_ERROR;
+	return ret;
+    }
+
+    /* 
+     * If the path isn't empty, we have no idea how to match files in
+     * a directory which belongs to no known filesystem
+     */
+
+    if (pathPtr != NULL && TclGetString(pathPtr)[0] != '\0') {
+	Tcl_SetErrno(ENOENT);
+	return -1;
+    }
+
+    /* 
+     * We have an empty or NULL path.  This is defined to mean we
+     * must search for files within the current 'cwd'.  We
+     * therefore use that, but then since the proc we call will
+     * return results which include the cwd we must then trim it
+     * off the front of each path in the result.  We choose to deal
+     * with this here (in the generic code), since if we don't,
+     * every single filesystem's implementation of
+     * Tcl_FSMatchInDirectory will have to deal with it for us.
+     */
+
+    cwd = Tcl_FSGetCwd(NULL);
+    if (cwd == NULL) {
+	if (interp != NULL) {
+	    Tcl_SetResult(interp, "glob couldn't determine "
+		    "the current working directory", TCL_STATIC);
 	}
-	fsPtr = Tcl_FSGetFileSystemForPath(cwd);
-	if (fsPtr != NULL) {
-	    Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
-	    if (proc != NULL) {
-		Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL);
-		Tcl_IncrRefCount(tmpResultPtr);
-		ret = (*proc)(interp, tmpResultPtr, cwd, pattern, types);
-		if (ret == TCL_OK) {
-		    int resLength;
-
-		    tmpResultPtr = FsAddMountsToGlobResult(tmpResultPtr, cwd,
-							   pattern, types);
-
-		    ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength);
-		    if (ret == TCL_OK) {
-			int i;
-
-			for (i = 0; i < resLength; i++) {
-			    Tcl_Obj *elt;
-			    
-			    Tcl_ListObjIndex(interp, tmpResultPtr, i, &elt);
-			    Tcl_ListObjAppendElement(interp, result, 
-				TclFSMakePathRelative(interp, elt, cwd));
-			}
-		    }
-		}
-		Tcl_DecrRefCount(tmpResultPtr);
+	return TCL_ERROR;
+    }
+
+    fsPtr = Tcl_FSGetFileSystemForPath(cwd);
+    if (fsPtr != NULL && fsPtr->matchInDirectoryProc != NULL) {
+	TclNewObj(tmpResultPtr);
+	Tcl_IncrRefCount(tmpResultPtr);
+	ret = (*fsPtr->matchInDirectoryProc)(interp, tmpResultPtr, cwd,
+		pattern, types);
+	if (ret == TCL_OK) {
+	    FsAddMountsToGlobResult(tmpResultPtr, cwd, pattern, types);
+	    /* Note that we know resultPtr and tmpResultPtr are distinct */
+	    ret = Tcl_ListObjGetElements(interp, tmpResultPtr,
+		    &resLength, &elemsPtr);
+	    for (i = 0; ret == TCL_OK && i < resLength; i++) {
+		ret = Tcl_ListObjAppendElement(interp, resultPtr,
+			TclFSMakePathRelative(interp, elemsPtr[i], cwd));
 	    }
 	}
-	Tcl_DecrRefCount(cwd);
-	return ret;
+	TclDecrRefCount(tmpResultPtr);
     }
-    Tcl_SetErrno(ENOENT);
-    return -1;
+    Tcl_DecrRefCount(cwd);
+    return ret;
 }
 
 /*
@@ -1120,20 +1114,20 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
  *	'glob *' merge mounts and listings correctly.
  *	
  * Results: 
- *	
- *	The passed in 'result' may be modified (in place, if
- *	necessary), and the correct list is returned.
+ *	None.
  *
  * Side effects:
- *	None.
+ *	Modifies the resultPtr.
  *
  *---------------------------------------------------------------------- 
  */
-static Tcl_Obj*
-FsAddMountsToGlobResult(result, pathPtr, pattern, types)
-    Tcl_Obj *result;            /* The current list of matching paths */
-    Tcl_Obj *pathPtr;           /* The directory in question */
-    CONST char *pattern;        /* Pattern to match against. */
+
+static void
+FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types)
+    Tcl_Obj *resultPtr;		/* The current list of matching paths; must
+				 * not be shared! */
+    Tcl_Obj *pathPtr;		/* The directory in question */
+    CONST char *pattern;	/* Pattern to match against. */
     Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
 				 * May be NULL. In particular the directory
 				 * flag is very important. */
@@ -1142,12 +1136,14 @@ FsAddMountsToGlobResult(result, pathPtr, pattern, types)
     int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));
     Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);
 
-    if (mounts == NULL) return result; 
+    if (mounts == NULL) {
+	return;
+    }
 
     if (Tcl_ListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
 	goto endOfMounts;
     }
-    if (Tcl_ListObjLength(NULL, result, &gLength) != TCL_OK) {
+    if (Tcl_ListObjLength(NULL, resultPtr, &gLength) != TCL_OK) {
 	goto endOfMounts;
     }
     for (i = 0; i < mLength; i++) {
@@ -1159,18 +1155,13 @@ FsAddMountsToGlobResult(result, pathPtr, pattern, types)
 
 	for (j = 0; j < gLength; j++) {
 	    Tcl_Obj *gElt;
-	    Tcl_ListObjIndex(NULL, result, j, &gElt);
+
+	    Tcl_ListObjIndex(NULL, resultPtr, j, &gElt);
 	    if (Tcl_FSEqualPaths(mElt, gElt)) {
 		found = 1;
 		if (!dir) {
 		    /* We don't want to list this */
-		    if (Tcl_IsShared(result)) {
-			Tcl_Obj *newList;
-			newList = Tcl_DuplicateObj(result);
-			Tcl_DecrRefCount(result);
-			result = newList;
-		    }
-		    Tcl_ListObjReplace(NULL, result, j, 1, 0, NULL);
+		    Tcl_ListObjReplace(NULL, resultPtr, j, 1, 0, NULL);
 		    gLength--;
 		}
 		/* Break out of for loop */
@@ -1181,12 +1172,7 @@ FsAddMountsToGlobResult(result, pathPtr, pattern, types)
             int len, mlen;
             CONST char *path;
             CONST char *mount;
-	    if (Tcl_IsShared(result)) {
-		Tcl_Obj *newList;
-		newList = Tcl_DuplicateObj(result);
-		Tcl_DecrRefCount(result);
-		result = newList;
-	    }
+
             /* 
              * We know mElt is absolute normalized and lies inside pathPtr, 
              * so now we must add to the result the right
@@ -1201,7 +1187,7 @@ FsAddMountsToGlobResult(result, pathPtr, pattern, types)
                 len--;
             }
             mElt = TclNewFSPathObj(pathPtr, mount + len + 1, mlen - len);
-            Tcl_ListObjAppendElement(NULL, result, mElt);
+            Tcl_ListObjAppendElement(NULL, resultPtr, mElt);
 	    /* 
 	     * No need to increment gLength, since we
 	     * don't want to compare mounts against
@@ -1209,9 +1195,9 @@ FsAddMountsToGlobResult(result, pathPtr, pattern, types)
 	     */
 	}
     }
+
   endOfMounts:
     Tcl_DecrRefCount(mounts);
-    return result;
 }
 
 /*