4 fs fixes

FossilOrigin-Name: d33368661952a4384e657612e1b3b49a2bd6b278

5 files changed, 83 insertions, 52 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index d5f4bd3..fbac80c 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.121 2002/03/20 22:47:36 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.122 2002/03/24 11:41:48 vincentdarley Exp $
  */
 
 #ifndef _TCL
@@ -1788,28 +1788,31 @@ typedef struct Tcl_Filesystem {
 			     * '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
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 61d4df2..cc920ce 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -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: tclFCmd.c,v 1.16 2002/02/15 14:28:49 dkf Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.17 2002/03/24 11:41:50 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -716,10 +716,9 @@ FileForceOption(interp, objc, objv, forcePtr)
  *	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.
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 28cd1e2..0e184de 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.32 2002/02/27 06:39:16 hobbs Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.33 2002/03/24 11:41:50 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -2454,21 +2454,18 @@ TclDoGlob(interp, separators, headPtr, tail, types)
 	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 @@ TclDoGlob(interp, separators, headPtr, tail, types)
 	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;
     }
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 2172bfd..9432c8f 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.36 2002/02/15 23:42:12 kennykb Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.37 2002/03/24 11:41:50 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -397,10 +397,10 @@ static Tcl_Filesystem nativeFilesystem = {
     &TclpObjCreateDirectory,
     &TclpObjRemoveDirectory, 
     &TclpObjDeleteFile,
-    &TclpObjLstat,
     &TclpObjCopyFile,
     &TclpObjRenameFile,
     &TclpObjCopyDirectory, 
+    &TclpObjLstat,
     &TclpLoadFile,
     &TclpObjGetCwd,
     &TclpObjChdir
@@ -1651,6 +1651,10 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
  *	write, since they can assume the pathPtr passed to them
  *	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: 
  *	
@@ -1703,10 +1707,14 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
 	    }
 	}
 	/* 
-	 * 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) {
@@ -1723,11 +1731,7 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
 		int cwdLen;
 		Tcl_Obj *cwdDir;
 		char *cwdStr;
-#ifdef MAC_TCL
-		char sep = ':';
-#else
-		char sep = '/';
-#endif
+		char sep = 0;
 		Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL);
 		/* 
 		 * We know the cwd is a normalised object which does
@@ -1744,10 +1748,33 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
 		cwdDir = Tcl_DuplicateObj(cwd);
 		Tcl_IncrRefCount(cwdDir);
 		cwdStr = Tcl_GetStringFromObj(cwdDir, &cwdLen);
-		if (cwdStr[cwdLen-1] != sep) {
+		/* 
+		 * Should we perhaps use 'Tcl_FSPathSeparator'?
+		 * But then what about the Windows special case?
+		 * Perhaps we should just check if cwd is a root
+		 * volume.
+		 */
+		switch (tclPlatform) {
+		    case TCL_PLATFORM_UNIX:
+			if (cwdStr[cwdLen-1] != '/') {
+			    sep == '/';
+			}
+			break;
+		    case TCL_PLATFORM_WINDOWS:
+			if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') {
+			    sep = '/';
+			}
+			break;
+		    case TCL_PLATFORM_MAC:
+			if (cwdStr[cwdLen-1] != ':') {
+			    sep = ':';
+			}
+			break;
+		}
+		if (sep != 0) {
 		    Tcl_AppendToObj(cwdDir, &sep, 1);
 		    cwdLen++;
-		    /* Note: cwdStr may no longer be a valid pointer */
+		    /* Note: cwdStr may no longer be a valid pointer now */
 		}
 		ret = (*proc)(interp, tmpResultPtr, cwdDir, pattern, types);
 		Tcl_DecrRefCount(cwdDir);
@@ -3682,6 +3709,11 @@ SetFsPathFromAny(interp, objPtr)
  *      and that path is to be used at the Tcl level, then calling
  *      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 +3773,8 @@ Tcl_FSNewNativePath(fromFilesystem, clientData)
     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 +4608,7 @@ Tcl_FSGetFileSystemForPath(pathObjPtr)
  * 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.
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 5aeff82..128b390 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -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: tclTest.c,v 1.47 2002/03/07 20:17:22 dgp Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.48 2002/03/24 11:41:50 vincentdarley Exp $
  */
 
 #define TCL_TEST
@@ -409,10 +409,10 @@ static Tcl_Filesystem testReportingFilesystem = {
     &TestReportCreateDirectory,
     &TestReportRemoveDirectory, 
     &TestReportDeleteFile,
-    &TestReportLstat,
     &TestReportCopyFile,
     &TestReportRenameFile,
     &TestReportCopyDirectory, 
+    &TestReportLstat,
     &TestReportLoadFile,
     NULL /* cwd */,
     &TestReportChdir
@@ -5658,10 +5658,15 @@ TestReport(cmd, path, arg2)
     if (interp == NULL) {
 	/* This is bad, but not much we can do about it */
     } else {
+	/* 
+	 * No idea why I decided to program this up using the
+	 * old string-based API, but there you go.  We should
+	 * convert it to objects.
+	 */
 	Tcl_SavedResult savedResult;
 	Tcl_DString ds;
 	Tcl_DStringInit(&ds);
-	Tcl_DStringAppend(&ds, "puts stderr ",-1);
+	Tcl_DStringAppend(&ds, "lappend filesystemReport ",-1);
 	Tcl_DStringStartSublist(&ds);
 	Tcl_DStringAppendElement(&ds, cmd);
 	if (path != NULL) {
@@ -5677,6 +5682,7 @@ TestReport(cmd, path, arg2)
 	Tcl_RestoreResult(interp, &savedResult);
    }
 }
+
 static int
 TestReportStat(path, buf)
     Tcl_Obj *path;		/* Path of file to stat (in current CP). */