summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2003-02-05 12:46:17 (GMT)
committervincentdarley <vincentdarley>2003-02-05 12:46:17 (GMT)
commit630b31eb1db036388d30359b456d2bee9c4e499b (patch)
treef53a4c4b1fd728b04e777777d066726a6a30d9cc /generic/tclTest.c
parent3dac6b45f9d6639c9bece03e3ada8d6b196fab12 (diff)
downloadtcl-630b31eb1db036388d30359b456d2bee9c4e499b.zip
tcl-630b31eb1db036388d30359b456d2bee9c4e499b.tar.gz
tcl-630b31eb1db036388d30359b456d2bee9c4e499b.tar.bz2
added regression test for recent bug fix
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c84
1 files changed, 61 insertions, 23 deletions
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*