summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclTest.c84
-rw-r--r--tests/fileSystem.test15
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