fs

7 files changed, 117 insertions, 29 deletions

diff --git a/ChangeLog b/ChangeLog
index 32c4198..f47ddc7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2001-09-06 Vince Darley <vincentdarley@users.sourceforge.net>
+
+	* generic/tclTest.c: tests of old-fs hooks no longer cause problems
+	in threaded builds.  Also removed unused unload proc.
+	* generic/tcl.decls:
+	* generic/tclIOUtilc: added Tcl_FSMountsChanged so that a vfs
+	can inform the filesystem that the filesystem epoch must be
+	changed (since cached filesystems may now be incorrect).  Fixes
+	problem running tclvfs extension.
+	* library/tcltest/tcltest.tcl: if tests aren't in a native
+	filesystem, then don't use pipes to run them. [Bug 458741]
+	
 2001-09-06  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
 	* generic/tcl.decls (479 generic): 
diff --git a/generic/tcl.decls b/generic/tcl.decls
index a4783ab..a356955 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -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: tcl.decls,v 1.55 2001/09/06 09:35:38 dkf Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.56 2001/09/06 17:51:00 vincentdarley Exp $
 
 library tcl
 
@@ -1678,6 +1678,9 @@ declare 478 generic {
 declare 479 generic {
     int Tcl_OutputBuffered(Tcl_Channel chan)
 }
+declare 480 generic {
+    void Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr)
+}
 		  
 ##############################################################################
 
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index a0c3a73..ca2d0f1 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclDecls.h,v 1.56 2001/09/06 09:35:38 dkf Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.57 2001/09/06 17:51:00 vincentdarley Exp $
  */
 
 #ifndef _TCLDECLS
@@ -1497,6 +1497,9 @@ EXTERN Tcl_Filesystem*	Tcl_FSGetFileSystemForPath _ANSI_ARGS_((
 EXTERN Tcl_PathType	Tcl_FSGetPathType _ANSI_ARGS_((Tcl_Obj * pathObjPtr));
 /* 479 */
 EXTERN int		Tcl_OutputBuffered _ANSI_ARGS_((Tcl_Channel chan));
+/* 480 */
+EXTERN void		Tcl_FSMountsChanged _ANSI_ARGS_((
+				Tcl_Filesystem * fsPtr));
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -2036,6 +2039,7 @@ typedef struct TclStubs {
     Tcl_Filesystem* (*tcl_FSGetFileSystemForPath) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 477 */
     Tcl_PathType (*tcl_FSGetPathType) _ANSI_ARGS_((Tcl_Obj * pathObjPtr)); /* 478 */
     int (*tcl_OutputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 479 */
+    void (*tcl_FSMountsChanged) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 480 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -3996,6 +4000,10 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_OutputBuffered \
 	(tclStubsPtr->tcl_OutputBuffered) /* 479 */
 #endif
+#ifndef Tcl_FSMountsChanged
+#define Tcl_FSMountsChanged \
+	(tclStubsPtr->tcl_FSMountsChanged) /* 480 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 96a33f8..2650ecd 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.18 2001/09/04 18:06:34 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.19 2001/09/06 17:51:00 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -367,7 +367,7 @@ static FilesystemRecord nativeFilesystemRecord = {
  * filesystems.  Any time it changes, all cached filesystem
  * representations are suspect and must be freed.
  */
-int filesystemEpoch = 0;
+int theFilesystemEpoch = 0;
 /* Stores the linked list of filesystems.*/
 static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
 /* 
@@ -566,7 +566,7 @@ Tcl_FSRegister(clientData, fsPtr)
      * Increment the filesystem epoch counter, since existing paths
      * might conceivably now belong to different filesystems.
      */
-    filesystemEpoch++;
+    theFilesystemEpoch++;
     Tcl_MutexUnlock(&filesystemMutex);
 
     return TCL_OK;
@@ -629,7 +629,7 @@ Tcl_FSUnregister(fsPtr)
 	     * do not reference that filesystem (which would of course
 	     * lead to memory exceptions).
 	     */
-	    filesystemEpoch++;
+	    theFilesystemEpoch++;
 	    
 	    tmpFsRecPtr->fileRefCount--;
 	    if (tmpFsRecPtr->fileRefCount <= 0) {
@@ -650,6 +650,69 @@ Tcl_FSUnregister(fsPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_FSMountsChanged --
+ *
+ *    Notify the filesystem that the available mounted filesystems
+ *    (or within any one filesystem type, the number or location of
+ *    mount points) have changed.
+ *
+ * Results:
+ *    None.
+ *
+ * Side effects:
+ *    The global filesystem variable 'theFilesystemEpoch' is
+ *    incremented.  The effect of this is to make all cached
+ *    path representations invalid.  Clearly it should only therefore
+ *    be called when it is really required!  There are a few 
+ *    circumstances when it should be called:
+ *    
+ *    (1) when a new filesystem is registered or unregistered.  
+ *    Strictly speaking this is only necessary if the new filesystem
+ *    accepts file paths as is (normally the filesystem itself is
+ *    really a shell which hasn't yet had any mount points established
+ *    and so its 'pathInFilesystem' proc will always fail).  However,
+ *    for safety, Tcl always calls this for you in these circumstances.
+ * 
+ *    (2) when additional mount points are established inside any
+ *    existing filesystem (except the native fs)
+ *    
+ *    (3) when any filesystem (except the native fs) changes the list
+ *    of available volumes.
+ *    
+ *    Tcl has no control over (2) and (3), so any registered filesystem
+ *    must make sure it calls this function when those situations
+ *    occur.
+ *    
+ *    (Note: the reason for the exception in 2,3 for the native
+ *    filesystem is that the native filesystem by default claims all
+ *    unknown files even if it really doesn't understand them or if
+ *    they don't exist).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FSMountsChanged(fsPtr)
+    Tcl_Filesystem *fsPtr;
+{
+    /* 
+     * We currently don't do anything with this parameter.  We
+     * could in the future only invalidate files for this filesystem
+     * or otherwise take more advanced action.
+     */
+    (void)fsPtr;
+    /* 
+     * Increment the filesystem epoch counter, since existing paths
+     * might now belong to different filesystems.
+     */
+    Tcl_MutexLock(&filesystemMutex);
+    theFilesystemEpoch++;
+    Tcl_MutexUnlock(&filesystemMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_FSData --
  *
  *    Retrieve the clientData field for the filesystem given,
@@ -4290,12 +4353,12 @@ Tcl_FSGetFileSystemForPath(pathObjPtr)
     }
     
     /* 
-     * Get a lock on filesystemEpoch and the filesystemList
+     * Get a lock on theFilesystemEpoch and the filesystemList
      * 
-     * While we don't need the fsRecPtr until the while loop
-     * below, we do want to make sure the filesystemEpoch doesn't
-     * change between the 'if' and 'while' blocks, getting this
-     * iterator will ensure that everything is consistent
+     * While we don't need the fsRecPtr until the while loop below, we
+     * do want to make sure the theFilesystemEpoch doesn't change
+     * between the 'if' and 'while' blocks, getting this iterator will
+     * ensure that everything is consistent
      */
     fsRecPtr = FsGetIterator();
     
@@ -4308,7 +4371,7 @@ Tcl_FSGetFileSystemForPath(pathObjPtr)
 	 * Check if the filesystem has changed in some way since
 	 * this object's internal representation was calculated.
 	 */
-	if (srcFsPathPtr->filesystemEpoch != filesystemEpoch) {
+	if (srcFsPathPtr->filesystemEpoch != theFilesystemEpoch) {
 	    /* 
 	     * We have to discard the stale representation and 
 	     * recalculate it 
@@ -4346,7 +4409,7 @@ Tcl_FSGetFileSystemForPath(pathObjPtr)
 		 */
 		srcFsPathPtr->fsRecPtr = fsRecPtr;
 		srcFsPathPtr->nativePathPtr = clientData;
-		srcFsPathPtr->filesystemEpoch = filesystemEpoch;
+		srcFsPathPtr->filesystemEpoch = theFilesystemEpoch;
 		fsRecPtr->fileRefCount++;
 		retVal = fsRecPtr->fsPtr;
 	    }
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index a3c6b02..f216358 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStubInit.c,v 1.58 2001/09/06 09:35:39 dkf Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.59 2001/09/06 17:51:00 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -876,6 +876,7 @@ TclStubs tclStubs = {
     Tcl_FSGetFileSystemForPath, /* 477 */
     Tcl_FSGetPathType, /* 478 */
     Tcl_OutputBuffered, /* 479 */
+    Tcl_FSMountsChanged, /* 480 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index af93ff6..396a321 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.29 2001/09/04 18:06:34 vincentdarley Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.30 2001/09/06 17:51:00 vincentdarley Exp $
  */
 
 #define TCL_TEST
@@ -328,7 +328,6 @@ static Tcl_FSCreateDirectoryProc TestReportCreateDirectory;
 static Tcl_FSCopyDirectoryProc TestReportCopyDirectory; 
 static Tcl_FSRemoveDirectoryProc TestReportRemoveDirectory; 
 static Tcl_FSLoadFileProc TestReportLoadFile;
-static Tcl_FSUnloadFileProc TestReportUnloadFile;
 static Tcl_FSLinkProc TestReportLink;
 static Tcl_FSFileAttrStringsProc TestReportFileAttrStrings;
 static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet;
@@ -4091,7 +4090,7 @@ static int PretendTclpStat(path, buf)
     int ret;
     Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
     Tcl_IncrRefCount(pathPtr);
-    ret = Tcl_FSStat(pathPtr, buf);
+    ret = TclpObjStat(pathPtr, buf);
     Tcl_DecrRefCount(pathPtr);
     return ret;
 }
@@ -4245,7 +4244,7 @@ static int PretendTclpAccess(path, mode)
     int ret;
     Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
     Tcl_IncrRefCount(pathPtr);
-    ret = Tcl_FSAccess(pathPtr, mode);
+    ret = TclpObjAccess(pathPtr, mode);
     Tcl_DecrRefCount(pathPtr);
     return ret;
 }
@@ -4366,7 +4365,7 @@ PretendTclpOpenFileChannel(interp, fileName, modeString, permissions)
     Tcl_Channel ret;
     Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName, -1);
     Tcl_IncrRefCount(pathPtr);
-    ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
+    ret = TclpOpenFileChannel(interp, pathPtr, modeString, permissions);
     Tcl_DecrRefCount(pathPtr);
     return ret;
 }
@@ -5422,15 +5421,6 @@ TestReportLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr,
     return Tcl_FSLoadFile(interp, TestReportGetNativePath(fileName), sym1, sym2,
 			  proc1Ptr, proc2Ptr, clientDataPtr, unloadProcPtr);
 }
-static void
-TestReportUnloadFile(clientData)
-    ClientData clientData;    /* ClientData returned by a previous call
-			       * to TclpLoadFile().  The clientData is 
-			       * a token that represents the loaded 
-			       * file. */
-{
-    TestReport("unloadfile",NULL,NULL);
-}
 static Tcl_Obj *
 TestReportLink(path, to)
     Tcl_Obj *path;		/* Path of file to readlink or link */
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 83c584e..bca10be 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -13,7 +13,7 @@
 # Copyright (c) 2000 by Ajuba Solutions
 # All rights reserved.
 # 
-# RCS: @(#) $Id: tcltest.tcl,v 1.32 2001/08/22 23:55:45 hobbs Exp $
+# RCS: @(#) $Id: tcltest.tcl,v 1.33 2001/09/06 17:51:00 vincentdarley Exp $
 
 # create the "tcltest" namespace for all testing variables and procedures
 
@@ -2921,6 +2921,17 @@ proc tcltest::runAllTests { {shell ""} } {
     puts [outputChannel] "Tests located in:  $tcltest::testsDirectory"
     puts [outputChannel] "Tests running in:  [tcltest::workingDirectory]"
     puts [outputChannel] "Temporary files stored in $tcltest::temporaryDirectory"
+    
+    if {[package vcompare [package provide Tcl] 8.4] >= 0} {
+	# If we aren't running in the native filesystem, then we must
+	# run the tests in a single process (via 'source'), because
+	# trying to run then via a pipe will fail since the files don't
+	# really exist.
+	if {[lindex [file system [tcltest::testsDirectory]] 0] != "native"} {
+	    tcltest::singleProcess 1
+	}
+    }
+
     if {[tcltest::singleProcess]} {
 	puts [outputChannel] "Test files sourced into current interpreter"
     } else {