summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2003-10-22 22:35:45 (GMT)
committerandreas_kupries <akupries@shaw.ca>2003-10-22 22:35:45 (GMT)
commit1be328e65c44844c92b1d464ec916f1d2097e5db (patch)
treeec410cf26fa91a938dada03026c5823da24c17e9 /generic
parentfcd9762272f467238addbbfcc715432865d64ae6 (diff)
downloadtcl-1be328e65c44844c92b1d464ec916f1d2097e5db.zip
tcl-1be328e65c44844c92b1d464ec916f1d2097e5db.tar.gz
tcl-1be328e65c44844c92b1d464ec916f1d2097e5db.tar.bz2
* 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.
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h3
-rw-r--r--generic/tclIOUtil.c155
-rw-r--r--generic/tclTest.c17
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)