vfs glob root volume fix

5 files changed, 145 insertions, 15 deletions

diff --git a/ChangeLog b/ChangeLog
index 137651f..d51d6de 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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]