? vfsGlobVol.patch
Index: generic/tclFileName.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFileName.c,v
retrieving revision 1.53
diff -b -u -r1.53 tclFileName.c
--- generic/tclFileName.c	6 Apr 2004 22:25:51 -0000	1.53
+++ generic/tclFileName.c	6 May 2004 19:15:38 -0000
@@ -1696,6 +1696,20 @@
     }
     
     /* 
+     * 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 @@
  *	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
Index: generic/tclFileSystem.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFileSystem.h,v
retrieving revision 1.6
diff -b -u -r1.6 tclFileSystem.h
--- generic/tclFileSystem.h	21 Jan 2004 19:59:33 -0000	1.6
+++ generic/tclFileSystem.h	6 May 2004 19:15:38 -0000
@@ -86,11 +86,15 @@
 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));
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.101
diff -b -u -r1.101 tclIOUtil.c
--- generic/tclIOUtil.c	23 Apr 2004 12:09:37 -0000	1.101
+++ generic/tclIOUtil.c	6 May 2004 19:15:50 -0000
@@ -3469,13 +3469,70 @@
                                          * 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 @@
 	}
 	fsRecPtr = fsRecPtr->nextPtr;
     }
-    
-    if (type != TCL_PATH_ABSOLUTE) {
-	type = TclpGetNativePathType(pathPtr, driveNameLengthPtr, 
-				     driveNameRef);
-	if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
-	    *filesystemPtrPtr = &tclNativeFilesystem;
-	}
-    }
     return type;
 }
 
Index: tests/fileSystem.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/fileSystem.test,v
retrieving revision 1.40
diff -b -u -r1.40 fileSystem.test
--- tests/fileSystem.test	4 May 2004 22:31:10 -0000	1.40
+++ tests/fileSystem.test	6 May 2004 19:15:52 -0000
@@ -728,6 +728,57 @@
     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]
