added regression test for recent bug fix

3 files changed, 81 insertions, 24 deletions

diff --git a/ChangeLog b/ChangeLog
index 1f08b55..9ae2608 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,4 @@
-2003-01-28  Vince Darley  <vincentdarley@users.sourceforge.net>
+2003-02-04  Vince Darley  <vincentdarley@users.sourceforge.net>
 
 	* generic/tclIOUtil.c:
 	* generic/tclEvent.c:
@@ -22,6 +22,10 @@
 	* tests/io.test: fixed some test failures when tests are run 
 	from a directory containing spaces.
 	
+	* tests/fileSystem.test:
+	* generic/tclTest.c: added regression test for the modification
+	date setting of cross-platform file copies.
+	
 2003-02-01  Kevin Kenny  <kennykb@users.sourceforge.net>
 
 	* generic/tclCompCmds.c: Removed an unused variable that caused
diff --git a/generic/tclTest.c b/generic/tclTest.c
index f70f587..c3b52a9 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.57 2003/01/28 14:52:50 vincentdarley Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.58 2003/02/05 12:46:17 vincentdarley Exp $
  */
 
 #define TCL_TEST
@@ -399,7 +399,8 @@ static Tcl_Channel	SimpleOpenFileChannel _ANSI_ARGS_ ((
 static Tcl_Obj*         SimpleListVolumes _ANSI_ARGS_ ((void));
 static int              SimplePathInFilesystem _ANSI_ARGS_ ((
 			    Tcl_Obj *pathPtr, ClientData *clientDataPtr));
-
+static Tcl_Obj*         SimpleCopy _ANSI_ARGS_ ((Tcl_Interp *interp, 
+						 Tcl_Obj *pathPtr));
 
 static Tcl_Filesystem testReportingFilesystem = {
     "reporting",
@@ -6063,28 +6064,28 @@ SimplePathInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) {
     return TCL_OK;
 }
 
-static Tcl_Channel
-SimpleOpenFileChannel(interp, pathPtr, mode, permissions)
-    Tcl_Interp *interp;              /* Interpreter for error reporting;
+/* 
+ * Since TclCopyChannel insists on an interpreter, we use this
+ * to simplify our test scripts.  Would be better if it could
+ * copy without an interp
+ */
+static Tcl_Interp *simpleInterpPtr = NULL;
+
+/* 
+ * Treats a file name 'simplefs:/foo' by copying the file 'foo'
+ * in the current (native) directory to a temporary native file,
+ * and then returns that native file.
+ */
+static Tcl_Obj*
+SimpleCopy(interp, pathPtr)
+    Tcl_Interp *interp;                 /* Interpreter for error reporting;
 					 * can be NULL. */
-    Tcl_Obj *pathPtr;                   /* Name of file to open. */
-    int mode;             		/* POSIX open mode. */
-    int permissions;                    /* If the open involves creating a
-					 * file, with what modes to create
-					 * it? */
+    Tcl_Obj *pathPtr;                   /* Name of file to copy. */
 {
-    Tcl_Obj *tempPtr, *origPtr;
-    Tcl_Channel chan;
     int res;
     CONST char *str;
-    
-    if ((mode != 0) && !(mode & O_RDONLY)) {
-	Tcl_AppendResult(interp, "read-only", 
-		(char *) NULL);
-	return NULL;
-    }
-    
-    tempPtr = TclpTempFileName();
+    Tcl_Obj *origPtr;
+    Tcl_Obj *tempPtr = TclpTempFileName();
     Tcl_IncrRefCount(tempPtr);
 
     /* 
@@ -6094,14 +6095,45 @@ SimpleOpenFileChannel(interp, pathPtr, mode, permissions)
     origPtr = Tcl_NewStringObj(str+10,-1);
     Tcl_IncrRefCount(origPtr);
 
+    if (interp != NULL) {
+	simpleInterpPtr = interp;
+    } else {
+	interp = simpleInterpPtr;
+    }
     res = TclCrossFilesystemCopy(interp, origPtr, tempPtr);
-
     Tcl_DecrRefCount(origPtr);
 
     if (res != TCL_OK) {
 	Tcl_DecrRefCount(tempPtr);
 	return NULL;
     }
+    return tempPtr;
+}
+
+static Tcl_Channel
+SimpleOpenFileChannel(interp, pathPtr, mode, permissions)
+    Tcl_Interp *interp;                 /* Interpreter for error reporting;
+					 * can be NULL. */
+    Tcl_Obj *pathPtr;                   /* Name of file to open. */
+    int mode;             		/* POSIX open mode. */
+    int permissions;                    /* If the open involves creating a
+					 * file, with what modes to create
+					 * it? */
+{
+    Tcl_Obj *tempPtr;
+    Tcl_Channel chan;
+    
+    if ((mode != 0) && !(mode & O_RDONLY)) {
+	Tcl_AppendResult(interp, "read-only", 
+		(char *) NULL);
+	return NULL;
+    }
+    
+    tempPtr = SimpleCopy(interp, pathPtr);
+    
+    if (tempPtr == NULL) {
+	return NULL;
+    }
     
     chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions);
 
@@ -6124,8 +6156,14 @@ SimpleStat(pathPtr, bufPtr)
     Tcl_Obj *pathPtr;		/* Path of file to stat (in current CP). */
     Tcl_StatBuf *bufPtr;	/* Filled with results of stat call. */
 {
-    /* All files exist */
-    return TCL_OK;
+    Tcl_Obj *tempPtr = SimpleCopy(NULL, pathPtr);
+    if (tempPtr == NULL) {
+	return TCL_ERROR;
+    } else {
+	int res = Tcl_FSStat(tempPtr, bufPtr);
+	Tcl_DecrRefCount(tempPtr);
+	return res;
+    }
 }
 
 static Tcl_Obj*
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 3dbaf88..f015270 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -404,6 +404,21 @@ test filesystem-7.1 {load from vfs} {win} {
     # The real result of this test is what happens when Tcl exits.
 } {ok}
 
+test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} {
+    set dir [pwd]
+    cd [file dirname [info script]]
+    set origtime [file mtime [info script]]
+    set dir [pwd]
+    testsimplefilesystem 1
+    file delete -force theCopy
+    file copy simplefs:/[file tail [info script]] theCopy
+    testsimplefilesystem 0
+    set newtime [file mtime theCopy]
+    file delete theCopy
+    cd $dir
+    expr {$origtime == $newtime}
+} {1}
+
 cleanupTests
 }
 namespace delete ::tcl::test::fileSystem