? tests/fileSystem.test
? win/efile
? win/outdata
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.907
diff -b -u -r1.907 ChangeLog
--- ChangeLog	15 Mar 2002 15:39:06 -0000	1.907
+++ ChangeLog	16 Mar 2002 17:22:25 -0000
@@ -4,6 +4,38 @@
 	* generic/tclCompile.c (TclCompileTokens): Fixed buffer overrun
 	reported in bug 530320.
 
+2002-03-15  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* generic/tclFilename.c
+	* generic/tclFCmd.c
+	* generic/tclTest.c
+	* generic/tcl.h
+	* generic/tclIOUtil.c
+	* win/tclWinFile.c:
+	* win/tclWinFCmd.c:
+	* unix/tclUnixFile.c:
+	* unix/tclUnixFCmd.c:
+	* mac/tclMacFile.c:
+	* doc/FileSystem.3:
+	* doc/file.n:
+	* tests/cmdAH.test:
+	* tests/fileName.test:
+	* tests/winFCmd.test:
+	* tests/fileSystem.test: fix [Bug 511666] and [Bug 511658],
+	and improved documentation of some aspects of the filesystem,
+	particularly 'Tcl_FSMatchInDirectory' which now might match
+	a single file/directory only.  Removed inconsistency betweens
+	docs and the Tcl_Filesystem structure.  Also fixed [Bug] and
+	corrected file normalization on Unix so that it expands
+	symbolic links.  Added some new tests of the filesystem code,
+	and some extra tests for correct handling of symbolic links.
+	
+	***POTENTIAL INCOMPATIBILITY***: But only between alpha
+	releases (users of the new Tcl_Filesystem lookup table in 
+	Tcl 8.4a4 will need to update their code, and 'file
+	normalize' on unix now behaves correctly).  Only known
+	impact is with the 'tclvfs' extension.
+
 2002-03-14  Mo DeJong  <mdejong@users.sourceforge.net>
 
 	* win/configure: Regen.
Index: doc/FileSystem.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/FileSystem.3,v
retrieving revision 1.19
diff -b -u -r1.19 FileSystem.3
--- doc/FileSystem.3	15 Feb 2002 14:28:47 -0000	1.19
+++ doc/FileSystem.3	16 Mar 2002 17:22:30 -0000
@@ -495,7 +495,11 @@
 .PP
 It returns the normalized path object, with refCount of zero, or NULL 
 if the path was invalid or could otherwise not be successfully
-converted.
+converted.  Extraction of absolute, normalized paths is very
+efficient (because the filesystem operates on these representations
+internally), although the result when the filesystem contains
+numerous symbolic links may not be the most user-friendly
+version of a path.
 .PP
 \fBTcl_FSJoinToPath\fR takes the given object, which should usually be a
 valid path or NULL, and joins onto it the array of paths segments
@@ -529,12 +533,14 @@
 .PP
 If the translation succeeds (i.e. the object is a valid path), then it
 is returned.  Otherwise NULL will be returned, and an error message may
-be left in the interpreter.
+be left in the interpreter.  A "translated" path is one which
+contains no "~" or "~user" sequences (these have been expanded to
+their current representation in the filesystem).
 .PP
 \fBTcl_FSGetTranslatedStringPath\fR does the same as 
 \fBTcl_FSGetTranslatedPath\fR, but returns a character string or NULL.
 .PP
-\fBTcl_FSNewNativePath\fR performs the something like that reverse of the
+\fBTcl_FSNewNativePath\fR performs something like that reverse of the
 usual obj->path->nativerep conversions.  If some code retrieves a path
 in native form (from, e.g. readlink or a native dialog), and that path
 is to be used at the Tcl level, then calling this function is an
@@ -666,10 +672,62 @@
 \fITcl_FSDeleteFileProc\fR, and if \fITcl_FSCopyFileProc\fR is not
 implemented there is a further fallback).  However, if a
 \fITcl_FSRenameFile\fR command is issued at the C level, no such
-fallbacks occur.  This is true except for the last five entries in the
-filesystem table (lstat, load, unload, getcwd and chdir)
+fallbacks occur.  This is true except for the last four entries in the
+filesystem table (lstat, load, getcwd and chdir)
 for which fallbacks do in fact occur at the C level.
 .PP
+As an example, here is the filesystem lookup table used by the
+"vfs" extension which allows filesystem actions to be implemented
+in Tcl.
+.CS
+static Tcl_Filesystem vfsFilesystem = {
+    "tclvfs",
+    sizeof(Tcl_Filesystem),
+    TCL_FILESYSTEM_VERSION_1,
+    &VfsPathInFilesystem,
+    &VfsDupInternalRep,
+    &VfsFreeInternalRep,
+    /* No internal to normalized, since we don't create any
+     * pure 'internal' Tcl_Obj path representations */
+    NULL,
+    /* No create native rep function, since we don't use it
+     * and don't choose to support uses of 'Tcl_FSNewNativePath' */
+    NULL,
+    /* Normalize path isn't needed - we assume paths only have
+     * one representation */
+    NULL,
+    &VfsFilesystemPathType,
+    &VfsFilesystemSeparator,
+    &VfsStat,
+    &VfsAccess,
+    &VfsOpenFileChannel,
+    &VfsMatchInDirectory,
+    &VfsUtime,
+    /* We choose not to support symbolic links inside our vfs's */
+    NULL,
+    &VfsListVolumes,
+    &VfsFileAttrStrings,
+    &VfsFileAttrsGet,
+    &VfsFileAttrsSet,
+    &VfsCreateDirectory,
+    &VfsRemoveDirectory, 
+    &VfsDeleteFile,
+    /* No copy file - fallback will occur at Tcl level */
+    NULL,
+    /* No rename file - fallback will occur at Tcl level */
+    NULL,
+    /* No copy directory - fallback will occur at Tcl level */
+    NULL, 
+    /* Core will use stat for lstat */
+    NULL,
+    /* No load - fallback on core implementation */
+    NULL,
+    /* We don't need a getcwd or chdir - fallback on Tcl's versions */
+    NULL,
+    NULL
+};
+.CE
+.PP
 Any functions which take path names in Tcl_Obj form take
 those names in UTF\-8 form.  The filesystem infrastructure API is
 designed to support efficient, cached conversion of these UTF\-8 paths
@@ -768,7 +826,13 @@
 there may be more than one unnormalized string representation which
 refers to that path (e.g. a relative path, a path with different
 character case if the filesystem is case insensitive, a path contain a
-reference to a home directory such as '~', etc).
+reference to a home directory such as '~', a path containing symbolic
+links, etc).  If the very last component in the path is a symbolic
+link, it should not be converted into the object it points to (but
+its case or other aspects should be made unique).  All other path
+components should be converted from symbolic links.  This one
+exception is required to agree with Tcl's semantics with 'file
+delete', 'file rename', 'file copy' operating on symbolic links.
 .PP
 .CS
 typedef int Tcl_FSNormalizePathProc(
@@ -909,9 +973,13 @@
 .PP
 The function should return all files or directories (or other
 filesystem objects) which match the given pattern and accord with the
-\fItypes\fR specification given.  The directory \fIpathPtr\fR, in which
-the function should search, can be assumed to be both non-NULL and
-non-empty.
+\fItypes\fR specification given.  There are two ways in which this 
+function may be called.  If \fIpattern\fR is NULL, then \fIpathPtr\fR
+is a full path specification of a single file or directory which
+should be checked for existence and correct type.  Otherwise, \fIpathPtr\fR
+is a directory, the contents of which the function should search for 
+files or directories which have the correct type.  In either case,
+\fIpathPtr\fR can be assumed to be both non-NULL and non-empty.  
 .PP
 The return value is a standard Tcl result indicating whether an error
 occurred in the matching process.  Error messages are placed in interp, 
@@ -920,6 +988,9 @@
 (which can be assumed to be a valid Tcl list).  The matches added
 to \fIresult\fR should include any path prefix given in \fIpathPtr\fR 
 (this usually means they will be absolute path specifications).
+Note that if no matches are found, that simply leads to an empty 
+result --- errors are only signalled for actual file or filesystem
+problems which may occur during the matching process.
 .SH UTIMEPROC       
 .PP
 Function to process a \fBTcl_FSUtime()\fR call.  Required to allow setting
@@ -1164,7 +1235,8 @@
 Function to process a \fBTcl_FSLoadFile()\fR call.  If not implemented, Tcl
 will fall back on a copy to native-temp followed by a Tcl_FSLoadFile on
 that temporary copy.  Therefore it need only be implemented if the
-filesystem can load code directly, or to disable load functionality
+filesystem can load code directly, or it can be implemented simply to
+return TCL_ERROR to disable load functionality in this filesystem
 entirely.
 .PP
 .CS
Index: doc/file.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/file.n,v
retrieving revision 1.13
diff -b -u -r1.13 file.n
--- doc/file.n	10 Dec 2001 15:50:47 -0000	1.13
+++ doc/file.n	16 Mar 2002 17:22:32 -0000
@@ -110,17 +110,20 @@
 .TP
 \fBfile delete \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIpathname\fR ?\fIpathname\fR ... ?
 .
-Removes the file or directory specified by each \fIpathname\fR argument.
-Non-empty directories will be removed only if the \fB\-force\fR option is
-specified.  Trying to delete a non-existent file is not considered an
-error.  Trying to delete a read-only file will cause the file to be deleted,
+Removes the file or directory specified by each \fIpathname\fR
+argument.  Non-empty directories will be removed only if the
+\fB\-force\fR option is specified.  When operating on symbolic links,
+the links themselves will be deleted, not the objects they point to.
+Trying to delete a non-existent file is not considered an error.
+Trying to delete a read-only file will cause the file to be deleted,
 even if the \fB\-force\fR flags is not specified.  If the \fB\-force\fR 
 option is specified on a directory, Tcl will attempt both to change
 permissions and move the current directory 'pwd' out of the given path
-if that is necessary to allow the deletion to proceed. Arguments are processed
-in the order specified, halting at the first error, if any.  A \fB\-\|\-\fR
-marks the end of switches; the argument following the \fB\-\|\-\fR will be
-treated as a \fIpathname\fR even if it starts with a \fB\-\fR.
+if that is necessary to allow the deletion to proceed.  Arguments are
+processed in the order specified, halting at the first error, if any.
+A \fB\-\|\-\fR marks the end of switches; the argument following the
+\fB\-\|\-\fR will be treated as a \fIpathname\fR even if it starts with
+a \fB\-\fR.
 .TP
 \fBfile dirname \fIname\fR
 Returns a name comprised of all of the path components in \fIname\fR
@@ -227,11 +230,16 @@
 string value can be used as a unique identifier for the it.  A
 normalized path is one which has all '../', './' removed.  Also it is
 one which is in the ``standard'' format for the native platform.  On
-MacOS, Unix, this means the path must be free of symbolic
-links/aliases, and on Windows it also means means we want the long form
-(when running Win NT/2000/XP) or the short form (when running Win
+MacOS, Unix, this means the segments leading up to the path must be
+free of symbolic links/aliases (but the very last path component may be
+a symbolic link), and on Windows it also means means we want the long
+form (when running Win NT/2000/XP) or the short form (when running Win
 95/98) with that form's case-dependence (which gives us a unique,
-case-dependent path).
+case-dependent path).  The one exception concerning the last link in
+the path is necessary, because Tcl or the user may wish to operate on
+the actual symbolic link itself (for example 'file delete', 'file
+rename', 'file copy' are defined to operate on symbolic links, not on
+the things that they point to).
 .TP
 \fBfile owned \fIname\fR 
 .
@@ -267,12 +275,14 @@
 The first form takes the file or directory specified by pathname
 \fIsource\fR and renames it to \fItarget\fR, moving the file if the
 pathname \fItarget\fR specifies a name in a different directory.  If
-\fItarget\fR is an existing directory, then the second form is used.  The
-second form moves each \fIsource\fR file or directory into the directory
-\fItargetDir\fR.  Existing files will not be overwritten unless the
-\fB\-force\fR option is specified.  Trying to overwrite a non-empty
-directory, overwrite a directory with a file, or a file with a directory
-will all result in errors.  Arguments are processed in the order specified,
+\fItarget\fR is an existing directory, then the second form is used.
+The second form moves each \fIsource\fR file or directory into the
+directory \fItargetDir\fR. Existing files will not be overwritten
+unless the \fB\-force\fR option is specified.  When operating inside a
+single filesystem, Tcl will rename symbolic links rather than the
+things that they point to.  Trying to overwrite a non-empty directory,
+overwrite a directory with a file, or a file with a directory will all
+result in errors.  Arguments are processed in the order specified,
 halting at the first error, if any.  A \fB\-\|\-\fR marks the end of
 switches; the argument following the \fB\-\|\-\fR will be treated as a
 \fIsource\fR even if it starts with a \fB\-\fR.
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.120
diff -b -u -r1.120 tcl.h
--- generic/tcl.h	6 Mar 2002 15:20:23 -0000	1.120
+++ generic/tcl.h	16 Mar 2002 17:22:40 -0000
@@ -1788,28 +1788,31 @@
 			     * 'Tcl_FSDeleteFile()' call.  Should
 			     * be implemented unless the FS is
 			     * read-only. */
-    Tcl_FSLstatProc *lstatProc;	    
-			    /* Function to process a 
-			     * 'Tcl_FSLstat()' call.  If not implemented,
-			     * Tcl will attempt to use the 'statProc'
-			     * defined above instead. */
     Tcl_FSCopyFileProc *copyFileProc; 
 			    /* Function to process a 
 			     * 'Tcl_FSCopyFile()' call.  If not
 			     * implemented Tcl will fall back
 			     * on open-r, open-w and fcopy as
-			     * a copying mechanism. */
+			     * a copying mechanism, for copying
+			     * actions initiated in Tcl (not C). */
     Tcl_FSRenameFileProc *renameFileProc;	    
 			    /* Function to process a 
 			     * 'Tcl_FSRenameFile()' call.  If not
 			     * implemented, Tcl will fall back on
-			     * a copy and delete mechanism. */
+			     * a copy and delete mechanism, for 
+			     * rename actions initiated in Tcl (not C). */
     Tcl_FSCopyDirectoryProc *copyDirectoryProc;	    
 			    /* Function to process a 
 			     * 'Tcl_FSCopyDirectory()' call.  If
 			     * not implemented, Tcl will fall back
 			     * on a recursive create-dir, file copy
-			     * mechanism. */
+			     * mechanism, for copying actions
+			     * initiated in Tcl (not C). */
+    Tcl_FSLstatProc *lstatProc;	    
+			    /* Function to process a 
+			     * 'Tcl_FSLstat()' call.  If not implemented,
+			     * Tcl will attempt to use the 'statProc'
+			     * defined above instead. */
     Tcl_FSLoadFileProc *loadFileProc; 
 			    /* Function to process a 
 			     * 'Tcl_FSLoadFile()' call.  If not
Index: generic/tclFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFCmd.c,v
retrieving revision 1.16
diff -b -u -r1.16 tclFCmd.c
--- generic/tclFCmd.c	15 Feb 2002 14:28:49 -0000	1.16
+++ generic/tclFCmd.c	16 Mar 2002 17:22:42 -0000
@@ -716,10 +716,9 @@
  *	if path is the root directory, returns no characters.
  *
  * Results:
- *	Appends the string that represents the basename to the end of
- *	the specified initialized DString, returning a pointer to the
- *	resulting string.  If there is an error, an error message is left
- *	in interp, NULL is returned, and the Tcl_DString is unmodified.
+ *	Returns the string object that represents the basename.  If there 
+ *	is an error, an error message is left in interp, and NULL is 
+ *	returned.
  *
  * Side effects:
  *	None.
Index: generic/tclFileName.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFileName.c,v
retrieving revision 1.32
diff -b -u -r1.32 tclFileName.c
--- generic/tclFileName.c	27 Feb 2002 06:39:16 -0000	1.32
+++ generic/tclFileName.c	16 Mar 2002 17:22:49 -0000
@@ -2454,21 +2454,18 @@
 	return TclDoGlob(interp, separators, headPtr, p, types);
     } else {
 	/*
+	 * This is the code path reached by a command like 'glob foo'.
+	 *
 	 * There are no more wildcards in the pattern and no more
 	 * unprocessed characters in the tail, so now we can construct
-	 * the path and verify the existence of the file.
-	 * 
-	 * We can't use 'Tcl_(FS)Access' to verify existence because
-	 * this fails when the file is a symlink to another file which
-	 * doesn't actually exist.  The problem is that if 'foo' is
-	 * such a broken link, 'glob foo' and 'glob foo*' return
-	 * different results.  So, we use 'Tcl_FSLstat' below so those
-	 * two return the same result.  This fixes [Bug 434876, L.
-	 * Virden]
+	 * the path, and pass it to Tcl_FSMatchInDirectory with an
+	 * empty pattern to verify the existence of the file and check
+	 * it is of the correct type (if a 'types' flag it given -- if
+	 * no such flag was given, we could just use 'Tcl_FSLStat', but
+	 * for simplicity we keep to a common approach).
 	 */
 
 	Tcl_Obj *nameObj;
-	Tcl_StatBuf buf;
 	/* Used to deal with one special case pertinent to MacOS */
 	int macSpecialCase = 0;
 
@@ -2518,16 +2515,8 @@
 	nameObj = Tcl_NewStringObj(name, Tcl_DStringLength(headPtr));
 
 	Tcl_IncrRefCount(nameObj);
-	if (Tcl_FSLstat(nameObj, &buf) == 0) {
-	    if (macSpecialCase && (name[1] != '\0') 
-	      && (strchr(name+1, ':') == NULL)) {
-		Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), 
-					 Tcl_NewStringObj(name + 1,-1));
-	    } else {
-		Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), 
-					 nameObj);
-	    }
-	}
+	Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), nameObj, 
+			       NULL, types);
 	Tcl_DecrRefCount(nameObj);
 	return TCL_OK;
     }
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.36
diff -b -u -r1.36 tclIOUtil.c
--- generic/tclIOUtil.c	15 Feb 2002 23:42:12 -0000	1.36
+++ generic/tclIOUtil.c	16 Mar 2002 17:23:03 -0000
@@ -397,10 +397,10 @@
     &TclpObjCreateDirectory,
     &TclpObjRemoveDirectory, 
     &TclpObjDeleteFile,
-    &TclpObjLstat,
     &TclpObjCopyFile,
     &TclpObjRenameFile,
     &TclpObjCopyDirectory, 
+    &TclpObjLstat,
     &TclpLoadFile,
     &TclpObjGetCwd,
     &TclpObjChdir
@@ -1652,6 +1652,10 @@
  *	is an ordinary path.  In fact this means we could remove such
  *	special case handling from Tcl's native filesystems.
  *
+ *	If 'pattern' is NULL, then pathPtr is assumed to be a fully
+ *	specified path of a single file/directory which must be
+ *	checked for existence and correct type.
+ *
  * Results: 
  *	
  *	The return value is a standard Tcl result indicating whether an
@@ -1703,10 +1707,14 @@
 	    }
 	}
 	/* 
-	 * We have a null string, this means we must use the 'cwd', and
-	 * then manipulate the result.  We must deal with this here,
-	 * since if we don't, every single filesystem's implementation
-	 * of Tcl_FSMatchInDirectory will have to deal with it for us.
+	 * We have an empty or NULL path.  This is defined to mean we
+	 * must search for files within the current 'cwd'.  We
+	 * therefore use that, but then since the proc we call will
+	 * return results which include the cwd we must then trim it
+	 * off the front of each path in the result.  We choose to deal
+	 * with this here (in the generic code), since if we don't,
+	 * every single filesystem's implementation of
+	 * Tcl_FSMatchInDirectory will have to deal with it for us.
 	 */
 	cwd = Tcl_FSGetCwd(NULL);
 	if (cwd == NULL) {
@@ -3683,6 +3691,11 @@
  *      this function is an efficient way of creating the appropriate
  *      path object type.
  *
+ *      Any memory which is allocated for 'clientData' should be retained
+ *      until clientData is passed to the filesystem's freeInternalRepProc
+ *      when it can be freed.  The built in platform-specific filesystems
+ *      use 'ckalloc' to allocate clientData, and ckfree to free it.
+ *
  * Results:
  *      NULL or a valid path object pointer, with refCount zero.
  *
@@ -3741,6 +3754,8 @@
     fsPathPtr->cwdPtr = NULL;
     fsPathPtr->nativePathPtr = clientData;
     fsPathPtr->fsRecPtr = fsFromPtr->fsRecPtr;
+    /* We must increase the refCount for this filesystem. */
+    fsPathPtr->fsRecPtr->fileRefCount++;
     fsPathPtr->filesystemEpoch = fsFromPtr->filesystemEpoch;
 
     objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr;
@@ -4574,7 +4589,7 @@
  * Tcl_FSEqualPaths --
  *
  *      This function tests whether the two paths given are equal path
- *      objects.
+ *      objects.  If either or both is NULL, 0 is always returned.
  *
  * Results:
  *      1 or 0.
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.47
diff -b -u -r1.47 tclTest.c
--- generic/tclTest.c	7 Mar 2002 20:17:22 -0000	1.47
+++ generic/tclTest.c	16 Mar 2002 17:23:25 -0000
@@ -409,10 +409,10 @@
     &TestReportCreateDirectory,
     &TestReportRemoveDirectory, 
     &TestReportDeleteFile,
-    &TestReportLstat,
     &TestReportCopyFile,
     &TestReportRenameFile,
     &TestReportCopyDirectory, 
+    &TestReportLstat,
     &TestReportLoadFile,
     NULL /* cwd */,
     &TestReportChdir
Index: mac/tclMacFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacFile.c,v
retrieving revision 1.17
diff -b -u -r1.17 tclMacFile.c
--- mac/tclMacFile.c	15 Feb 2002 14:28:49 -0000	1.17
+++ mac/tclMacFile.c	16 Mar 2002 17:23:28 -0000
@@ -31,6 +31,8 @@
 #include <MoreFilesExtras.h>
 #include <FSpCompat.h>
 
+static int NativeMatchType(Tcl_Obj *tempName, Tcl_GlobTypeData *types, 
+			   HFileInfo fileInfo, OSType okType, OSType okCreator);
 static OSErr FspLocationFromFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr, 
 						FSSpec* specPtr));
 
@@ -128,11 +130,56 @@
     Tcl_Interp *interp;		/* Interpreter to receive errors. */
     Tcl_Obj *resultPtr;		/* List object to lappend results. */
     Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
-    CONST char *pattern;	/* Pattern to match against. */
+    CONST char *pattern;	/* Pattern to match against.  NULL or empty
+                        	 * means pathPtr is actually a single file
+                        	 * to check. */
     Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
 				 * May be NULL. In particular the directory
 				 * flag is very important. */
 {
+    OSType okType = 0;
+    OSType okCreator = 0;
+    Tcl_Obj *fileNamePtr;
+
+    fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+    if (fileNamePtr == NULL) {
+	return TCL_ERROR;
+    }
+    
+    if (types != NULL) {
+	if (types->macType != NULL) {
+	    Tcl_GetOSTypeFromObj(NULL, types->macType, &okType);
+	}
+	if (types->macCreator != NULL) {
+	    Tcl_GetOSTypeFromObj(NULL, types->macCreator, &okCreator);
+	}
+    }
+
+    if (pattern == NULL || (*pattern == '\0')) {
+	/* Match a file directly */
+	struct stat buf;
+	int len;
+	char *fname;
+
+	if (TclpObjLstat(fileNamePtr, &buf) != 0) {
+	    /* File doesn't exist */
+	    return TCL_OK;
+	}
+
+	fname = Tcl_GetStringFromObj(pathPtr,&len);
+
+	/* Need to get the 'hFileInfo' for this path */
+	if (NativeMatchType(fileNamePtr, types, pb.hFileInfo,
+			    okType, okCreator) {
+	    if ((len > 1) && (strchr(fname+1, ':') == NULL)) {
+		Tcl_ListObjAppendElement(interp, resultPtr, 
+			Tcl_NewStringObj(fname+1, fnameLen-1));
+	    } else {
+		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
+	    }
+	}
+	return TCL_OK;
+    } else {
     char *fname;
     int fnameLen, result = TCL_OK;
     int baseLength;
@@ -144,15 +191,8 @@
     short itemIndex;
     Str255 fileName;
     Tcl_DString fileString;    
-    OSType okType = 0;
-    OSType okCreator = 0;
     Tcl_DString dsOrig;
-    Tcl_Obj *fileNamePtr;
 
-    fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
-    if (fileNamePtr == NULL) {
-	return TCL_ERROR;
-    }
     Tcl_DStringInit(&dsOrig);
     Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
     baseLength = Tcl_DStringLength(&dsOrig);
@@ -168,8 +208,10 @@
     err = FSpLocationFromPath(Tcl_DStringLength(&fileString), 
 			      Tcl_DStringValue(&fileString), &dirSpec);
     Tcl_DStringFree(&fileString);
-	if (err == noErr)
+	if (err == noErr) {
     err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
+	}
+	
     if ((err != noErr) || !isDirectory) {
     /*
      * Check if we had a relative path (unix style relative path 
@@ -186,8 +228,10 @@
     err = FSpLocationFromPath(Tcl_DStringLength(&fileString), 
 			      Tcl_DStringValue(&fileString), &dirSpec);
     Tcl_DStringFree(&fileString);
-    if (err == noErr)
+	    if (err == noErr) {
     err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
+	    }
+	    
     if ((err != noErr) || !isDirectory) {
 		Tcl_DStringFree(&dsOrig);
 		return TCL_OK;
@@ -209,15 +253,6 @@
     pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
     pb.hFileInfo.ioFDirIndex = itemIndex = 1;
 
-    if (types != NULL) {
-	if (types->macType != NULL) {
-	    Tcl_GetOSTypeFromObj(NULL, types->macType, &okType);
-	}
-	if (types->macCreator != NULL) {
-	    Tcl_GetOSTypeFromObj(NULL, types->macCreator, &okCreator);
-	}
-    }
-
     while (1) {
 	pb.hFileInfo.ioFDirIndex = itemIndex;
 	pb.hFileInfo.ioDirID = dirID;
@@ -233,7 +268,6 @@
 	Tcl_ExternalToUtfDString(NULL, (char *) fileName + 1, fileName[0],
 		&fileString);
 	if (Tcl_StringMatch(Tcl_DStringValue(&fileString), pattern)) {
-	    int typeOk = 1;
 	    Tcl_Obj *tempName;
 	    Tcl_DStringSetLength(&dsOrig, baseLength);
 	    Tcl_DStringAppend(&dsOrig, Tcl_DStringValue(&fileString), -1);
@@ -247,30 +281,63 @@
 	    tempName = Tcl_NewStringObj(fname, fnameLen);
 	    Tcl_IncrRefCount(tempName);
 
+		/* Is the type acceptable? */
+		if (NativeMatchType(tempName, types, pb.hFileInfo,
+				    okType, okCreator) {
+		    if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {
+			Tcl_ListObjAppendElement(interp, resultPtr, 
+				Tcl_NewStringObj(fname+1, fnameLen-1));
+		    } else {
+			Tcl_ListObjAppendElement(interp, resultPtr, tempName);
+		    }
+		}
+		/* 
+		 * This will free the object, unless it was inserted in
+		 * the result list above.
+		 */
+		Tcl_DecrRefCount(tempName);
+	    }
+	    Tcl_DStringFree(&fileString);
+	    itemIndex++;
+	}
+
+	Tcl_DStringFree(&dsOrig);
+	return result;
+    }
+}
+
+static int 
+NativeMatchType(
+    Tcl_Obj *tempName,        /* Path to check */
+    Tcl_GlobTypeData *types,  /* Type description to match against */
+    HFileInfo fileInfo,       /* MacOS file info */
+    OSType okType,            /* Acceptable MacOS type, or zero */
+    OSType okCreator)         /* Acceptable MacOS creator, or zero */
+{
 	    if (types == NULL) {
 		/* If invisible, don't return the file */
-		if (pb.hFileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
-		    typeOk = 0;
+	if (fileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
+	    return 0;
 		}
 	    } else {
 		Tcl_StatBuf buf;
 		
-		if (pb.hFileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
+	if (fileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
 		    /* If invisible */
 		    if ((types->perm == 0) || 
 		      !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
-			typeOk = 0;
+		return 0;
 		    }
 		} else {
 		    /* Visible */
 		    if (types->perm & TCL_GLOB_PERM_HIDDEN) {
-			typeOk = 0;
+		return 0;
 		    }
 		}
-		if (typeOk == 1 && types->perm != 0) {
+	if (types->perm != 0) {
 		    if (
 			((types->perm & TCL_GLOB_PERM_RONLY) &&
-				!(pb.hFileInfo.ioFlAttrib & 1)) ||
+			!(fileInfo.ioFlAttrib & 1)) ||
 			((types->perm & TCL_GLOB_PERM_R) &&
 				(TclpObjAccess(tempName, R_OK) != 0)) ||
 			((types->perm & TCL_GLOB_PERM_W) &&
@@ -278,15 +345,14 @@
 			((types->perm & TCL_GLOB_PERM_X) &&
 				(TclpObjAccess(tempName, X_OK) != 0))
 			) {
-			typeOk = 0;
+		return 0;
 		    }
 		}
-		if (typeOk == 1 && types->type != 0) {
+	if (types->type != 0) {
 			if (TclpObjStat(tempName, &buf) != 0) {
 			    /* Posix error occurred */
-			    typeOk = 0;
+		return 0;
 			}
-		    if (typeOk) {
 			/*
 			 * In order bcdpfls as in 'find -t'
 			 */
@@ -301,15 +367,15 @@
 				    S_ISFIFO(buf.st_mode)) ||
 			    ((types->type & TCL_GLOB_TYPE_FILE) &&
 				    S_ISREG(buf.st_mode))
-    #ifdef S_ISSOCK
+#ifdef S_ISSOCK
 			    || ((types->type & TCL_GLOB_TYPE_SOCK) &&
 				    S_ISSOCK(buf.st_mode))
-    #endif
+#endif
 			    ) {
 			    /* Do nothing -- this file is ok */
 			} else {
-			    typeOk = 0;
-    #ifdef S_ISLNK
+		int typeOk = 0;
+#ifdef S_ISLNK
 			    if (types->type & TCL_GLOB_TYPE_LINK) {
 				if (TclpObjLstat(tempName, &buf) == 0) {
 				    if (S_ISLNK(buf.st_mode)) {
@@ -317,39 +383,22 @@
 				    }
 				}
 			    }
-    #endif
+#endif
+		if (typeOk == 0) {
+		    return 0;
 			}
 		    }
 		}
-		if (typeOk && (
-		    ((okType != 0) && (okType !=
-			    pb.hFileInfo.ioFlFndrInfo.fdType)) ||
+	if (((okType != 0) && (okType !=
+			       fileInfo.ioFlFndrInfo.fdType)) ||
 		    ((okCreator != 0) && (okCreator !=
-			    pb.hFileInfo.ioFlFndrInfo.fdCreator)))) {
-		    typeOk = 0;
-		}
-	    } 
-	    if (typeOk) {
-		if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {
-		    Tcl_ListObjAppendElement(interp, resultPtr, 
-			    Tcl_NewStringObj(fname+1, fnameLen-1));
-		} else {
-		    Tcl_ListObjAppendElement(interp, resultPtr, tempName);
+				  fileInfo.ioFlFndrInfo.fdCreator))) {
+	    return 0;
 		}
 	    }
-	    /* 
-	     * This will free the object, unless it was inserted in
-	     * the result list above.
-	     */
-	    Tcl_DecrRefCount(tempName);
-	}
-	Tcl_DStringFree(&fileString);
-	itemIndex++;
-    }
-
-    Tcl_DStringFree(&dsOrig);
-    return result;
+    return 1
 }
+
 
 /*
  *----------------------------------------------------------------------
Index: tests/cmdAH.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/cmdAH.test,v
retrieving revision 1.17
diff -b -u -r1.17 cmdAH.test
--- tests/cmdAH.test	27 Nov 2001 14:12:35 -0000	1.17
+++ tests/cmdAH.test	16 Mar 2002 17:23:31 -0000
@@ -1496,14 +1496,18 @@
 
 # type
 
-file delete link.file
-
 test cmdAH-29.1 {Tcl_FileObjCmd: type} {
     list [catch {file size a b} msg] $msg
 } {1 {wrong # args: should be "file size name"}}
 test cmdAH-29.2 {Tcl_FileObjCmd: type} {
     file type dir.file
 } directory
+test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {
+    set exists [list [file exists link.file] [file exists gorp.file]]
+    file delete link.file
+    set exists2	[list [file exists link.file] [file exists gorp.file]]
+    list $exists $exists2
+} {{1 1} {0 1}}
 test cmdAH-29.3 {Tcl_FileObjCmd: type} {
     file type gorp.file
 } file
Index: tests/fileName.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/fileName.test,v
retrieving revision 1.16
diff -b -u -r1.16 fileName.test
--- tests/fileName.test	23 Nov 2001 01:26:06 -0000	1.16
+++ tests/fileName.test	16 Mar 2002 17:23:34 -0000
@@ -1428,9 +1428,36 @@
 test filename-12.1 {simple globbing} {unixOrPc} {
     list [catch {glob {}} msg] $msg
 } {0 .}
+test filename-12.1.1 {simple globbing} {unixOrPc} {
+    list [catch {glob -types f {}} msg] $msg
+} {1 {no files matched glob pattern ""}}
+test filename-12.1.2 {simple globbing} {unixOrPc} {
+    list [catch {glob -types d {}} msg] $msg
+} {0 .}
+test filename-12.1.3 {simple globbing} {unixOnly} {
+    list [catch {glob -types hidden {}} msg] $msg
+} {0 .}
+test filename-12.1.4 {simple globbing} {unixpcOnly} {
+    list [catch {glob -types hidden {}} msg] $msg
+} {1 {no files matched glob pattern ""}}
+test filename-12.1.5 {simple globbing} {pcOnly} {
+    list [catch {glob -types hidden c:/} msg] $msg
+} {1 {no files matched glob pattern "c:/"}}
+test filename-12.1.6 {simple globbing} {pcOnly} {
+    list [catch {glob c:/} msg] $msg
+} {0 c:/}
 test filename-12.2 {simple globbing} {macOnly} {
     list [catch {glob {}} msg] $msg
 } {0 :}
+test filename-12.2.1 {simple globbing} {macOnly} {
+    list [catch {glob -types f {}} msg] $msg
+} {1 {no files matched glob pattern ""}}
+test filename-12.2.2 {simple globbing} {macOnly} {
+    list [catch {glob -types d {}} msg] $msg
+} {0 :}
+test filename-12.2.3 {simple globbing} {macOnly} {
+    list [catch {glob -types hidden {}} msg] $msg
+} {1 {no files matched glob pattern ""}}
 test filename-12.3 {simple globbing} {
     list [catch {glob -nocomplain \{a1,a2\}} msg] $msg
 } {0 {}}
Index: tests/winFCmd.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/winFCmd.test,v
retrieving revision 1.15
diff -b -u -r1.15 winFCmd.test
--- tests/winFCmd.test	19 Nov 2001 17:45:12 -0000	1.15
+++ tests/winFCmd.test	16 Mar 2002 17:23:37 -0000
@@ -840,7 +840,7 @@
     close [open td1 w]
     list [catch {file attributes td1 -system} msg] $msg [cleanup]
 } {0 0 {}}
-test winfcmd-11.5 {GetWinFileAttributes} {pcOnly} {
+test winFCmd-11.5 {GetWinFileAttributes} {pcOnly} {
     # attr of relative paths that resolve to root was failing
     # don't care about answer, just that test runs.
 
@@ -851,6 +851,9 @@
     file attr . 
     cd $old
 } {}
+test winFCmd-11.6 {GetWinFileAttributes} {pcOnly} {
+    file attr c:/ -hidden
+} {0}
 
 test winFCmd-12.1 {ConvertFileNameFormat} {pcOnly} {
     cleanup
Index: unix/tclUnixFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFCmd.c,v
retrieving revision 1.17
diff -b -u -r1.17 tclUnixFCmd.c
--- unix/tclUnixFCmd.c	15 Feb 2002 14:28:50 -0000	1.17
+++ unix/tclUnixFCmd.c	16 Mar 2002 17:23:44 -0000
@@ -1618,17 +1618,17 @@
  * TclpObjNormalizePath --
  *
  *	This function scans through a path specification and replaces
- *	it, in place, with a normalized version.  On unix, this simply
- *	ascertains where the valid path ends, and makes no change in
- *	place.
+ *	it, in place, with a normalized version.  A normalized version
+ *	is one in which all symlinks in the path are replaced with
+ *	their expanded form (except a symlink at the very end of the
+ *	path).
  *
  * Results:
  *	The new 'nextCheckpoint' value, giving as far as we could
  *	understand in the path.
  *
  * Side effects:
- *	The pathPtr string, which must contain a valid path, is
- *	not modified (unlike Windows, MacOS versions).
+ *	The pathPtr string, is modified.
  *
  *---------------------------------------------------------------------------
  */
@@ -1640,13 +1640,15 @@
     int nextCheckpoint;
 {
     char *currentPathEndPosition;
-    char *path = Tcl_GetString(pathPtr);
+    int pathLen;
+    char cur;
+    char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
 
     currentPathEndPosition = path + nextCheckpoint;
 
     while (1) {
-	char cur = *currentPathEndPosition;
-	if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
+	cur = *currentPathEndPosition;
+	if ((cur == '/') && (path != currentPathEndPosition)) {
 	    /* Reached directory separator, or end of string */
 	    Tcl_DString ds;
 	    CONST char *nativePath;
@@ -1660,13 +1662,59 @@
 		/* File doesn't exist */
 		break;
 	    }
-	    if (cur == 0) {
+	    /* Update the acceptable point */
+	    nextCheckpoint = currentPathEndPosition - path;
+	} else if (cur == 0) {
 		break;
 	    }
-	}
 	currentPathEndPosition++;
     }
-    nextCheckpoint = currentPathEndPosition - path;
-    /* We should really now convert this to a canonical path */
+    /* 
+     * We should really now convert this to a canonical path.  We do
+     * that with 'realpath' if we have it available.  Otherwise we could
+     * step through every single path component, checking whether it is a 
+     * symlink, but that would be a lot of work, and most modern OSes 
+     * have 'realpath'.
+     */
+#ifndef NO_REALPATH
+    if (1) {
+	char normPath[MAXPATHLEN];
+	Tcl_DString ds;
+	CONST char *nativePath = Tcl_UtfToExternalDString(NULL, path, 
+						   nextCheckpoint, &ds);
+	
+	if (realpath((char *) nativePath, normPath) != NULL) {
+	    /* 
+	     * Free up the native path and put in its place the
+	     * converted, normalized path.
+	     */
+	    Tcl_DStringFree(&ds);
+	    Tcl_ExternalToUtfDString(NULL,normPath,
+                                     strlen(normPath),&ds);
+
+	    if (path[nextCheckpoint] != '\0') {
+		/* not at end, append remaining path */
+	        int normLen = Tcl_DStringLength(&ds);
+		Tcl_DStringAppend(&ds, path + nextCheckpoint,
+				  pathLen - nextCheckpoint);
+                /* 
+                 * We recognise up to and including the directory
+                 * separator.
+		 */	
+	        nextCheckpoint = normLen + 1;
+	    } else {
+	        /* We recognise the whole string */ 
+	        nextCheckpoint = Tcl_DStringLength(&ds);
+	    }
+	    /* 
+	     * Overwrite with the normalized path.
+	     */
+	    Tcl_SetStringObj(pathPtr,Tcl_DStringValue(&ds),
+			     Tcl_DStringLength(&ds));
+	}
+	Tcl_DStringFree(&ds);
+    }
+#endif	/* !NO_REALPATH */
+
     return nextCheckpoint;
 }
Index: unix/tclUnixFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFile.c,v
retrieving revision 1.18
diff -b -u -r1.18 tclUnixFile.c
--- unix/tclUnixFile.c	15 Feb 2002 14:28:50 -0000	1.18
+++ unix/tclUnixFile.c	16 Mar 2002 17:23:44 -0000
@@ -15,6 +15,8 @@
 #include "tclInt.h"
 #include "tclPort.h"
 
+static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types);
+
 
 /*
  *---------------------------------------------------------------------------
@@ -205,7 +207,23 @@
 				 * May be NULL. In particular the directory
 				 * flag is very important. */
 {
-    CONST char *native, *fname, *dirName;
+    CONST char *native;
+    Tcl_Obj *fileNamePtr;
+
+    fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+    if (fileNamePtr == NULL) {
+	return TCL_ERROR;
+    }
+    
+    if (pattern == NULL || (*pattern == '\0')) {
+	/* Match a file directly */
+	CONST char *native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
+	if (NativeMatchType(native, types)) {
+	    Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
+	}
+	return TCL_OK;
+    } else {
+	CONST char *fname, *dirName;
     DIR *d;
     Tcl_DString ds;
     Tcl_StatBuf statBuf;
@@ -213,13 +231,8 @@
     int nativeDirLen;
     int result = TCL_OK;
     Tcl_DString dsOrig;
-    Tcl_Obj *fileNamePtr;
     int baseLength;
 
-    fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
-    if (fileNamePtr == NULL) {
-	return TCL_ERROR;
-    }
     Tcl_DStringInit(&dsOrig);
     Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
     baseLength = Tcl_DStringLength(&dsOrig);
@@ -333,15 +346,42 @@
 	    Tcl_DStringAppend(&dsOrig, utf, -1);
 	    fname = Tcl_DStringValue(&dsOrig);
 	    if (types != NULL) {
-		Tcl_StatBuf buf;
 		char *nativeEntry;
 		Tcl_DStringSetLength(&ds, nativeDirLen);
 		nativeEntry = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
+		    typeOk = NativeMatchType(nativeEntry, types);
+		}
+		if (typeOk) {
+		    Tcl_ListObjAppendElement(interp, resultPtr, 
+			    Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
+		}
+	    }
+	    Tcl_DStringFree(&utfDs);
+	}
+
+	closedir(d);
+	Tcl_DStringFree(&ds);
+	Tcl_DStringFree(&dsOrig);
+	return result;
+    }
+}
+static int 
+NativeMatchType(
+    CONST char* nativeEntry,  /* Native path to check */
+    Tcl_GlobTypeData *types)  /* Type description to match against */
+{
+    Tcl_StatBuf buf;
+    if (types == NULL) {
 		/* 
-		 * The native name of the file is in entryPtr->d_name.
-		 * We can use this below.
+	 * Simply check for the file's existence, but do it
+	 * with lstat, in case it is a link to a file which
+	 * doesn't exist (since that case would not show up
+	 * if we used 'access' or 'stat')
 		 */
-		
+	if (Tcl_PlatformLStat(nativeEntry, &buf) != 0) {
+	    return 0;
+	}
+    } else {
 		if (types->perm != 0) {
 		    if (Tcl_PlatformStat(nativeEntry, &buf) != 0) {
 			/* 
@@ -355,15 +395,14 @@
 			 * permission, and therefore it is not 
 			 * added to the list of files to return.
 			 */
-			typeOk = 0;
+		return 0;
 		    }
 		    
 		    /* 
 		     * readonly means that there are NO write permissions
 		     * (even for user), but execute is OK for anybody
 		     */
-		    if (typeOk && (
-			((types->perm & TCL_GLOB_PERM_RONLY) &&
+	    if (((types->perm & TCL_GLOB_PERM_RONLY) &&
 				(buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
 			((types->perm & TCL_GLOB_PERM_R) &&
 				(access(nativeEntry, R_OK) != 0)) ||
@@ -371,19 +410,18 @@
 				(access(nativeEntry, W_OK) != 0)) ||
 			((types->perm & TCL_GLOB_PERM_X) &&
 				(access(nativeEntry, X_OK) != 0))
-			)) {
-			typeOk = 0;
+		) {
+		return 0;
 		    }
 		}
-		if (typeOk && (types->type != 0)) {
+	if (types->type != 0) {
 		    if (types->perm == 0) {
 			/* We haven't yet done a stat on the file */
 			if (Tcl_PlatformStat(nativeEntry, &buf) != 0) {
 			    /* Posix error occurred */
-			    typeOk = 0;
+		    return 0;
 			}
 		    }
-		    if (typeOk) {
 			/*
 			 * In order bcdpfls as in 'find -t'
 			 */
@@ -398,37 +436,27 @@
 				    S_ISFIFO(buf.st_mode)) ||
 			    ((types->type & TCL_GLOB_TYPE_FILE) &&
 				    S_ISREG(buf.st_mode))
-#ifdef S_ISSOCK
+    #ifdef S_ISSOCK
 			    || ((types->type & TCL_GLOB_TYPE_SOCK) &&
 				    S_ISSOCK(buf.st_mode))
-#endif
+    #endif
 			    ) {
 			    /* Do nothing -- this file is ok */
 			} else {
-			    typeOk = 0;
-#ifdef S_ISLNK
-			    if ((types->type & TCL_GLOB_TYPE_LINK)
-				    && Tcl_PlatformLStat(nativeEntry, &buf)==0
-				    && S_ISLNK(buf.st_mode)) {
-				typeOk = 1;
+    #ifdef S_ISLNK
+		if (types->type & TCL_GLOB_TYPE_LINK) {
+		    if (Tcl_PlatformLStat(nativeEntry, &buf) == 0) {
+			if (S_ISLNK(buf.st_mode)) {
+			    return 1;
 			    }
-#endif
 			}
 		    }
+    #endif
+		return 0;
 		}
 	    }
-	    if (typeOk) {
-		Tcl_ListObjAppendElement(interp, resultPtr, 
-			Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
-	    }
-	}
-	Tcl_DStringFree(&utfDs);
     }
-
-    closedir(d);
-    Tcl_DStringFree(&ds);
-    Tcl_DStringFree(&dsOrig);
-    return result;
+    return 1;
 }
 
 /*
@@ -553,12 +581,7 @@
     Tcl_Obj *pathPtr;		/* Path of file to stat */
     Tcl_StatBuf *bufPtr;	/* Filled with results of stat call. */
 {
-    CONST char *path = Tcl_FSGetNativePath(pathPtr);
-    if (path == NULL) {
-	return -1;
-    } else {
-	return Tcl_PlatformLStat(path, bufPtr);
-    }
+    return Tcl_PlatformLStat(Tcl_FSGetNativePath(pathPtr), bufPtr);
 }
 
 /*
Index: win/tclWinFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinFCmd.c,v
retrieving revision 1.27
diff -b -u -r1.27 tclWinFCmd.c
--- win/tclWinFCmd.c	15 Mar 2002 01:10:19 -0000	1.27
+++ win/tclWinFCmd.c	16 Mar 2002 17:23:49 -0000
@@ -872,8 +872,6 @@
 				 * DString filled with UTF-8 name of file
 				 * causing error. */
 {
-    DWORD attr;
-
     /*
      * The RemoveDirectory API acts differently under Win95/98 and NT
      * WRT NULL and "". Avoid passing these values.
@@ -890,7 +888,7 @@
     TclWinConvertError(GetLastError());
 
     if (Tcl_GetErrno() == EACCES) {
-	attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+	DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
 	if (attr != 0xffffffff) {
 	    if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
 		/* 
@@ -1234,8 +1232,6 @@
     Tcl_DString *errorPtr)	/* If non-NULL, initialized DString filled
 				 * with UTF-8 name of file causing error. */
 {
-    DWORD attr;
-
     switch (type) {
 	case DOTREE_F: {
 	    if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) {
@@ -1245,7 +1241,7 @@
 	}
 	case DOTREE_PRED: {
 	    if (DoCreateDirectory(nativeDst) == TCL_OK) {
-		attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
+		DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
 		if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) {
 		    return TCL_OK;
 		}
@@ -1380,6 +1376,7 @@
 {
     DWORD result;
     CONST TCHAR *nativeName;
+    int attr;
 
     nativeName = Tcl_FSGetNativePath(fileName);
     result = (*tclWinProcs->getFileAttributesProc)(nativeName);
@@ -1389,7 +1386,34 @@
 	return TCL_ERROR;
     }
 
-    *attributePtrPtr = Tcl_NewBooleanObj((int) (result & attributeArray[objIndex]));
+    attr = (int)(result & attributeArray[objIndex]);
+    if ((objIndex == WIN_HIDDEN_ATTRIBUTE) && (attr != 0)) {
+	/* 
+	 * It is hidden.  However there is a bug on some Windows
+	 * OSes in which root volumes (drives) formatted as NTFS
+	 * are declared hidden when they are not (and cannot be).
+	 * 
+	 * We test for, and fix that case, here.
+	 */
+	int len;
+	char *str = Tcl_GetStringFromObj(fileName,&len);
+	if (len < 4) {
+	    if (len == 0) {
+		/* 
+		 * Not sure if this is possible, but we pass it on
+		 * anyway 
+		 */
+	    } else if (len == 1 && (str[0] == '/' || str[0] == '\\')) {
+		/* Path is pointing to the root volume */
+		attr = 0;
+	    } else if ((str[1] == ':') 
+		       && (len == 2 || (str[2] == '/' || str[2] == '\\'))) {
+		/* Path is of the form 'x:' or 'x:/' or 'x:\' */
+		attr = 0;
+	    }
+	}
+    }
+    *attributePtrPtr = Tcl_NewBooleanObj(attr);
     return TCL_OK;
 }
 
Index: win/tclWinFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinFile.c,v
retrieving revision 1.26
diff -b -u -r1.26 tclWinFile.c
--- win/tclWinFile.c	15 Feb 2002 14:28:51 -0000	1.26
+++ win/tclWinFile.c	16 Mar 2002 17:23:53 -0000
@@ -33,6 +33,8 @@
 static int NativeAccess(CONST TCHAR *path, int mode);
 static int NativeStat(CONST TCHAR *path, Tcl_StatBuf *statPtr);
 static int NativeIsExec(CONST TCHAR *path);
+static int NativeMatchType(int isDrive, CONST TCHAR* nativeName, 
+			   Tcl_GlobTypeData *types);
 
 
 /*
@@ -119,6 +121,33 @@
 				 * May be NULL. In particular the directory
 				 * flag is very important. */
 {
+    CONST TCHAR *nativeName;
+
+    if (pattern == NULL || (*pattern == '\0')) {
+	int isDrive = 0;
+	int len;
+	char *str = Tcl_GetStringFromObj(pathPtr,&len);
+	if (len < 4) {
+	    if (len == 0) {
+		/* 
+		 * Not sure if this is possible, but we pass it on
+		 * anyway 
+		 */
+	    } else if (len == 1 && (str[0] == '/' || str[0] == '\\')) {
+		/* Path is pointing to the root volume */
+		isDrive = 1;
+	    } else if ((str[1] == ':') && (len == 2 || (str[2] == '/' || str[2] == '\\'))) {
+		/* Path is of the form 'x:' or 'x:/' or 'x:\' */
+		isDrive = 1;
+	    }
+	}
+	/* Match a file directly */
+	nativeName = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr);
+	if (NativeMatchType(isDrive, nativeName, types)) {
+	    Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
+	}
+	return TCL_OK;
+    } else {
     char drivePat[] = "?:\\";
     const char *message;
     CONST char *dir;
@@ -132,7 +161,6 @@
     Tcl_DString ds;
     Tcl_DString dsOrig;
     Tcl_Obj *fileNamePtr;
-    CONST TCHAR *nativeName;
     int matchSpecialDots;
     
     /*
@@ -272,8 +300,6 @@
 	CONST TCHAR *nativeMatchResult;
 	CONST char *name, *fname;
 	
-	int typeOk = 1;
-	
 	if (tclWinProcs->useWide) {
 	    nativeName = (CONST TCHAR *) data.w.cFileName;
 	} else {
@@ -323,6 +349,48 @@
 	fname = Tcl_DStringValue(&dsOrig);
 	nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(&dsOrig), &ds);
 	
+	    if (NativeMatchType(0, nativeName, types)) {
+		Tcl_ListObjAppendElement(interp, resultPtr, 
+			Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
+	    }
+	    /*
+	     * Free ds here to ensure that nativeName is valid above.
+	     */
+
+	    Tcl_DStringFree(&ds);
+
+	    Tcl_DStringSetLength(&dsOrig, dirLength);
+	}
+
+	FindClose(handle);
+	Tcl_DStringFree(&dirString);
+	Tcl_DStringFree(&dsOrig);
+
+	return TCL_OK;
+	
+        error:
+	Tcl_DStringFree(&dirString);
+	TclWinConvertError(GetLastError());
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, message, Tcl_DStringValue(&dsOrig), "\": ", 
+			 Tcl_PosixError(interp), (char *) NULL);
+			 Tcl_DStringFree(&dsOrig);
+	return TCL_ERROR;
+    }
+
+}
+
+/* 
+ * This function needs a special case for a path which is a root
+ * volume, because for NTFS root volumes, the getFileAttributesProc
+ * returns a 'hidden' attribute when it should not.
+ */
+static int 
+NativeMatchType(
+    int isDrive,              /* Is this path a drive (root volume) */
+    CONST TCHAR* nativeName,  /* Native path to check */
+    Tcl_GlobTypeData *types)  /* Type description to match against */
+{
 	/*
 	 * 'attr' represents the attributes of the file, but we only
 	 * want to retrieve this info if it is absolutely necessary
@@ -332,27 +400,32 @@
 	 * look into.
 	 */
 
-	attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+    DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+    if (attr == 0xffffffff) {
+	/* File doesn't exist */
+	return 0;
+    }
+    
 	if (types == NULL) {
 	    /* If invisible, don't return the file */
-	    if (attr & FILE_ATTRIBUTE_HIDDEN) {
-		typeOk = 0;
+	if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
+	    return 0;
 	    }
 	} else {
-	    if (attr & FILE_ATTRIBUTE_HIDDEN) {
+	if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
 		/* If invisible */
 		if ((types->perm == 0) || 
 		  !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
-		    typeOk = 0;
+		return 0;
 		}
 	    } else {
 		/* Visible */
 		if (types->perm & TCL_GLOB_PERM_HIDDEN) {
-		    typeOk = 0;
+		return 0;
 		}
 	    }
 	    
-	    if (typeOk == 1 && types->perm != 0) {
+	if (types->perm != 0) {
 		if (
 		    ((types->perm & TCL_GLOB_PERM_RONLY) &&
 			    !(attr & FILE_ATTRIBUTE_READONLY)) ||
@@ -363,10 +436,10 @@
 		    ((types->perm & TCL_GLOB_PERM_X) &&
 			    (NativeAccess(nativeName, X_OK) != 0))
 		    ) {
-		    typeOk = 0;
+		return 0;
 		}
 	    }
-	    if (typeOk && types->type != 0) {
+	if (types->type != 0) {
 		Tcl_StatBuf buf;
 		
 		if (NativeStat(nativeName, &buf) != 0) {
@@ -376,9 +449,8 @@
 		     * strange error.  In any case we don't
 		     * return this file.
 		     */
-		    typeOk = 0;
+		return 0;
 		}
-		if (typeOk) {
 		    /*
 		     * In order bcdpfls as in 'find -t'
 		     */
@@ -400,7 +472,6 @@
 			) {
 			/* Do nothing -- this file is ok */
 		    } else {
-			typeOk = 0;
 #ifdef S_ISLNK
 			if (types->type & TCL_GLOB_TYPE_LINK) {
 			    /* 
@@ -409,42 +480,16 @@
 			     */
 			    if (NativeStat(nativeName, &buf) == 0) {
 				if (S_ISLNK(buf.st_mode)) {
-				    typeOk = 1;
+			    return 1;
 				}
 			    }
 			}
 #endif
+		return 0;
 		    }
 		}
 	    }		
-	} 
-	if (typeOk) {
-	    Tcl_ListObjAppendElement(interp, resultPtr, 
-		    Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
-	}
-	/*
-	 * Free ds here to ensure that nativeName is valid above.
-	 */
-
-	Tcl_DStringFree(&ds);
-
-	Tcl_DStringSetLength(&dsOrig, dirLength);
-    }
-
-    FindClose(handle);
-    Tcl_DStringFree(&dirString);
-    Tcl_DStringFree(&dsOrig);
-
-    return TCL_OK;
-
-    error:
-    Tcl_DStringFree(&dirString);
-    TclWinConvertError(GetLastError());
-    Tcl_ResetResult(interp);
-    Tcl_AppendResult(interp, message, Tcl_DStringValue(&dsOrig), "\": ", 
-	    Tcl_PosixError(interp), (char *) NULL);
-    Tcl_DStringFree(&dsOrig);
-    return TCL_ERROR;
+    return 1;
 }
 
 /*
