diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclFileName.c | 21 | ||||
| -rw-r--r-- | generic/tclFileSystem.h | 8 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 71 | ||||
| -rw-r--r-- | tests/fileSystem.test | 51 |
5 files changed, 145 insertions, 15 deletions
@@ -1,3 +1,12 @@ +2004-05-07 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tclFileName.c: + * generic/tclIOUtil.c: + * generic/tclFileSystem.h: + * tests/fileSystem.test: fix for [Bug 943995], in which vfs- + registered root volumes were not handled correctly as glob + patterns in all circumstances. + 2004-05-06 Miguel Sofer <msofer@users.sf.net> * generic/tclInt.h: diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 33f6f52..adbae7a 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.53 2004/04/06 22:25:51 dgp Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.54 2004/05/07 07:44:37 vincentdarley Exp $ */ #include "tclInt.h" @@ -1695,6 +1695,20 @@ 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; + if (TclFSNonnativePathType(tail, strlen(tail), NULL, &driveNameLen, + &driveName) == TCL_PATH_ABSOLUTE) { + pathPrefix = driveName; + tail += driveNameLen; + } + } + /* * We need to get the old result, in case it is over-written * below when we still need it. @@ -1852,7 +1866,10 @@ SkipToChar(stringPtr, match) * path name to be globbed and the pattern. The directory and * remainder are assumed to be native format paths. The prefix * contained in 'pathPtr' is either a directory or path from which - * to start the search (or NULL). + * to start the search (or NULL). If pathPtr is NULL, then the + * pattern must not start with an absolute path specification + * (that case should be handled by moving the absolute path + * prefix into pathPtr before calling DoGlob). * * Results: * The return value is a standard Tcl result indicating whether diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h index 8d0ab34..d63f7d5 100644 --- a/generic/tclFileSystem.h +++ b/generic/tclFileSystem.h @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclFileSystem.h,v 1.6 2004/01/21 19:59:33 vincentdarley Exp $ + * RCS: @(#) $Id: tclFileSystem.h,v 1.7 2004/05/07 07:44:37 vincentdarley Exp $ */ /* @@ -86,11 +86,15 @@ extern Tcl_Filesystem tclNativeFilesystem; extern Tcl_ThreadDataKey tclFsDataKey; /* - * Private shared functions for use by tclIOUtil.c and tclPathObj.c + * Private shared functions for use by tclIOUtil.c, tclPathObj.c + * and tclFileName.c */ Tcl_PathType TclFSGetPathType _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr)); +Tcl_PathType TclFSNonnativePathType _ANSI_ARGS_((CONST char *pathPtr, + int pathLen, Tcl_Filesystem **filesystemPtrPtr, + int *driveNameLengthPtr, Tcl_Obj **driveNameRef)); Tcl_PathType TclGetPathType _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef)); diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index f526d40..48621d8 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.101 2004/04/23 12:09:37 vincentdarley Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.102 2004/05/07 07:44:37 vincentdarley Exp $ */ #include "tclInt.h" @@ -3469,13 +3469,70 @@ TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef) * the path, already with a * refCount for the caller. */ { - FilesystemRecord *fsRecPtr; int pathLen; char *path; - Tcl_PathType type = TCL_PATH_RELATIVE; + Tcl_PathType type; path = Tcl_GetStringFromObj(pathPtr, &pathLen); + type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, + driveNameLengthPtr, driveNameRef); + + if (type != TCL_PATH_ABSOLUTE) { + type = TclpGetNativePathType(pathPtr, driveNameLengthPtr, + driveNameRef); + if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) { + *filesystemPtrPtr = &tclNativeFilesystem; + } + } + return type; +} + +/* + *---------------------------------------------------------------------- + * + * TclFSNonnativePathType -- + * + * Helper function used by TclGetPathType. Its purpose is to + * check whether the given path starts with a string which + * corresponds to a file volume in any registered filesystem + * except the native one. For speed and historical reasons the + * native filesystem has special hard-coded checks dotted here + * and there in the filesystem code. + * + * Results: + * Returns one of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE. + * The filesystem reference will be set if and only if it is + * non-NULL and the function's return value is TCL_PATH_ABSOLUTE. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_PathType +TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, + driveNameLengthPtr, driveNameRef) + CONST char *path; /* Path to determine type for */ + int pathLen; /* Length of the path */ + Tcl_Filesystem **filesystemPtrPtr; /* If absolute path and this is + * non-NULL, then set to the + * filesystem which claims this + * path */ + int *driveNameLengthPtr; /* If the path is absolute, and + * this is non-NULL, then set to + * the length of the driveName */ + Tcl_Obj **driveNameRef; /* If the path is absolute, and + * this is non-NULL, then set to + * the name of the drive, + * network-volume which contains + * the path, already with a + * refCount for the caller. */ +{ + FilesystemRecord *fsRecPtr; + Tcl_PathType type = TCL_PATH_RELATIVE; + /* * Call each of the "listVolumes" function in succession, checking * whether the given path is an absolute path on any of the volumes @@ -3557,14 +3614,6 @@ TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef) } fsRecPtr = fsRecPtr->nextPtr; } - - if (type != TCL_PATH_ABSOLUTE) { - type = TclpGetNativePathType(pathPtr, driveNameLengthPtr, - driveNameRef); - if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) { - *filesystemPtrPtr = &tclNativeFilesystem; - } - } return type; } diff --git a/tests/fileSystem.test b/tests/fileSystem.test index e9c4ee6..a45751f 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -728,6 +728,57 @@ test filesystem-7.3 {glob in simplefs} \ set res } {simplefs:/simpledir/simplefile} +test filesystem-7.3.1 {glob in simplefs: no path/dir} \ + {testsimplefilesystem} { + set dir [pwd] + cd [tcltest::temporaryDirectory] + file mkdir simpledir + close [open [file join simpledir simplefile] w] + testsimplefilesystem 1 + set res [glob -nocomplain simplefs:/simpledir/*] + eval lappend res [glob -nocomplain simplefs:/simpledir] + testsimplefilesystem 0 + file delete -force simpledir + cd $dir + set res +} {simplefs:/simpledir/simplefile simplefs:/simpledir} + +test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} \ + {testsimplefilesystem} { + set dir [pwd] + cd [tcltest::temporaryDirectory] + file mkdir simpledir + close [open [file join simpledir simplefile] w] + testsimplefilesystem 1 + set res [glob -nocomplain simplefs:/s*] + testsimplefilesystem 0 + file delete -force simpledir + cd $dir + if {[llength $res] > 0} { + set res "ok" + } else { + set res "no files found with 'glob -nocomplain simplefs:/s*'" + } +} {ok} + +test filesystem-7.3.3 {glob in simplefs: pattern is a volume} \ + {testsimplefilesystem} { + set dir [pwd] + cd [tcltest::temporaryDirectory] + file mkdir simpledir + close [open [file join simpledir simplefile] w] + testsimplefilesystem 1 + set res [glob -nocomplain simplefs:/*] + testsimplefilesystem 0 + file delete -force simpledir + cd $dir + if {[llength $res] > 0} { + set res "ok" + } else { + set res "no files found with 'glob -nocomplain simplefs:/*'" + } +} {ok} + test filesystem-7.4 {cross-filesystem file copy with -force} \ {testsimplefilesystem} { set dir [pwd] |