From 4eda61c04f6b1033a8a6e4fa26c4576549e2ab83 Mon Sep 17 00:00:00 2001 From: andreas_kupries Date: Wed, 22 Oct 2003 22:35:45 +0000 Subject: * 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. FossilOrigin-Name: a16319b2a6704b8177bb4d150a2990c6a44d161d --- ChangeLog | 16 +++++- generic/tcl.h | 3 +- generic/tclIOUtil.c | 155 +++++++++++++++++++++++++++++++++++++++++++++++++++- generic/tclTest.c | 17 ++++-- 4 files changed, 180 insertions(+), 11 deletions(-) diff --git a/ChangeLog b/ChangeLog index 3626613..41e9b35 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2003-10-22 Andreas Kupries + + * 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. + 2003-10-22 Donal K. Fellows * generic/tclCmdAH.c (Tcl_FileObjCmd): Changed FILE_ prefix for @@ -12,7 +24,7 @@ Added skipping of directives directly after .TP to avoid them being used as item descriptions, e.g. .TP\n.VS in clock.n. -2003-10-21 Andreas Kupries +2003-10-21 Andreas Kupries * win/tclWinPipe.c (BuildCommandLine): Applied the patch coming with [Bug 805605] to the code, fixing the incorrect use of @@ -1120,7 +1132,7 @@ common user errors due to confusion between [package names] names and [info loaded] names. -2003-02-25 Andreas Kupries +2003-02-25 Andreas Kupries * tests/pid.test: See below [Bug #678412]. * tests/io.test: Made more robust against spaces in paths 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) -- cgit v0.12