* generic/tclIOUtil.c (FsListMounts, FsAddMountsToGlobResult): New

	  functions. See below for context.
	  (Tcl_FSMatchInDirectory): Modified to call on the new functions
	  (above) to handle the mountpoints in the glob'bed directory
	  correctly. Part of the patch by Vincent Darly to solve the
	  [Bug 800106] for the 8.4.x series.

	* generic/tcl.h (TCL_GLOB_TYPE_MOUNT): New definition. Part of the
	  patch by Vincent Darly to solve [Bug 800106] for the 8.4.x series.

3 files changed, 166 insertions, 9 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 7d39feb..7d9afde 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.153.2.7 2003/10/02 23:07:33 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.153.2.8 2003/10/22 22:35:46 andreas_kupries Exp $
  */
 
 #ifndef _TCL
@@ -1591,6 +1591,7 @@ typedef struct Tcl_GlobTypeData {
 #define TCL_GLOB_TYPE_FILE		(1<<4)
 #define TCL_GLOB_TYPE_LINK		(1<<5)
 #define TCL_GLOB_TYPE_SOCK		(1<<6)
+#define TCL_GLOB_TYPE_MOUNT		(1<<7)
 
 #define TCL_GLOB_PERM_RONLY		(1<<0)
 #define TCL_GLOB_PERM_HIDDEN		(1<<1)
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 8de62f1..2da3666 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.77.2.10 2003/10/06 09:49:20 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.11 2003/10/22 22:35:46 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -102,6 +102,10 @@ static Tcl_Obj*  TclFSNormalizeAbsolutePath
 
 static FilesystemRecord* FsGetFirstFilesystem(void);
 static void FsThrExitProc(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));
 
 #ifdef TCL_THREADS
 static void FsRecacheFilesystemList(void);
@@ -1008,7 +1012,12 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
     if (fsPtr != NULL) {
 	Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
 	if (proc != NULL) {
-	    return (*proc)(interp, result, pathPtr, pattern, types);
+	    int ret = (*proc)(interp, result, pathPtr, pattern, types);
+	    if (ret == TCL_OK && pattern != NULL) {
+		result = FsAddMountsToGlobResult(result, pathPtr, 
+						 pattern, types);
+	    }
+	    return ret;
 	}
     } else {
 	Tcl_Obj* cwd;
@@ -1053,6 +1062,9 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, 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;
@@ -1079,6 +1091,92 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
 /*
  *----------------------------------------------------------------------
  *
+ * FsAddMountsToGlobResult --
+ *
+ *	This routine is used by the globbing code to take the results
+ *	of a directory listing and add any mounted paths to that
+ *	listing.  This is required so that simple things like 
+ *	'glob *' merge mounts and listings correctly.
+ *	
+ * Results: 
+ *	
+ *	The passed in 'result' may be modified (in place, if
+ *	necessary), and the correct list is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------- 
+ */
+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;
+    Tcl_GlobTypeData *types;
+{
+    int mLength, gLength, i;
+    int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));
+    Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);
+
+    if (mounts == NULL) return result; 
+
+    if (Tcl_ListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
+	goto endOfMounts;
+    }
+    if (Tcl_ListObjLength(NULL, result, &gLength) != TCL_OK) {
+	goto endOfMounts;
+    }
+    for (i = 0; i < mLength; i++) {
+	Tcl_Obj *mElt;
+	int j;
+	int found = 0;
+	
+	Tcl_ListObjIndex(NULL, mounts, i, &mElt);
+
+	for (j = 0; j < gLength; j++) {
+	    Tcl_Obj *gElt;
+	    Tcl_ListObjIndex(NULL, result, 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);
+		    gLength--;
+		}
+		/* Break out of for loop */
+		break;
+	    }
+	}
+	if (!found && dir) {
+	    if (Tcl_IsShared(result)) {
+		Tcl_Obj *newList;
+		newList = Tcl_DuplicateObj(result);
+		Tcl_DecrRefCount(result);
+		result = newList;
+	    }
+	    Tcl_ListObjAppendElement(NULL, result, mElt);
+	    /* 
+	     * No need to increment gLength, since we
+	     * don't want to compare mounts against
+	     * mounts.
+	     */
+	}
+    }
+  endOfMounts:
+    Tcl_DecrRefCount(mounts);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_FSMountsChanged --
  *
  *    Notify the filesystem that the available mounted filesystems
@@ -3027,6 +3125,59 @@ Tcl_FSListVolumes(void)
 /*
  *---------------------------------------------------------------------------
  *
+ * FsListMounts --
+ *
+ *	List all mounts within the given directory, which match the
+ *	given pattern.
+ *
+ * Results:
+ *	The list of mounts, in a list object which has refCount 0, or
+ *	NULL if we didn't even find any filesystems to try to list
+ *	mounts.
+ *
+ * Side effects:
+ *	None
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static Tcl_Obj*
+FsListMounts(pathPtr, pattern)
+    Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
+    CONST char *pattern;	/* Pattern to match against. */
+{
+    FilesystemRecord *fsRecPtr;
+    Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL };
+    Tcl_Obj *resultPtr = NULL;
+    
+    /*
+     * Call each of the "listMounts" functions in succession.
+     * A non-NULL return value indicates the particular function has
+     * succeeded.  We call all the functions registered, since we want
+     * a list from each filesystems.
+     */
+
+    fsRecPtr = FsGetFirstFilesystem();
+    while (fsRecPtr != NULL) {
+	if (fsRecPtr != &nativeFilesystemRecord) {
+	    Tcl_FSMatchInDirectoryProc *proc = 
+				  fsRecPtr->fsPtr->matchInDirectoryProc;
+	    if (proc != NULL) {
+		if (resultPtr == NULL) {
+		    resultPtr = Tcl_NewObj();
+		}
+		(*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly);
+	    }
+	}
+	fsRecPtr = fsRecPtr->nextPtr;
+    }
+    
+    return resultPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
  * Tcl_FSSplitPath --
  *
  *      This function takes the given Tcl_Obj, which should be a valid
diff --git a/generic/tclTest.c b/generic/tclTest.c
index d3abdfb..4ce051d 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.62.2.2 2003/10/08 14:21:20 dkf Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.62.2.3 2003/10/22 22:35:46 andreas_kupries Exp $
  */
 
 #define TCL_TEST
@@ -6091,16 +6091,21 @@ TestReportOpenFileChannel(interp, fileName, mode, permissions)
 static int
 TestReportMatchInDirectory(interp, resultPtr, dirPtr, pattern, types)
     Tcl_Interp *interp;		/* Interpreter to receive results. */
-    Tcl_Obj *resultPtr;		/* Directory separators to pass to TclDoGlob. */
+    Tcl_Obj *resultPtr;		/* Object to lappend results. */
     Tcl_Obj *dirPtr;	        /* Contains path to directory to search. */
     CONST char *pattern;	/* Pattern to match against. */
     Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
 				 * May be NULL. */
 {
-    TestReport("matchindirectory",dirPtr, NULL);
-    return Tcl_FSMatchInDirectory(interp, resultPtr, 
-				  TestReportGetNativePath(dirPtr), pattern, 
-				  types);
+    if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
+	TestReport("matchmounts",dirPtr, NULL);
+	return TCL_OK;
+    } else {
+	TestReport("matchindirectory",dirPtr, NULL);
+	return Tcl_FSMatchInDirectory(interp, resultPtr, 
+				      TestReportGetNativePath(dirPtr), pattern, 
+				      types);
+    }
 }
 static int
 TestReportChdir(dirName)