summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2004-01-29 10:28:18 (GMT)
committervincentdarley <vincentdarley>2004-01-29 10:28:18 (GMT)
commitf5c319ed1e839e9256fcad85b69c4fde1d5d7c97 (patch)
treebc4f25a47a8614d6ef6beed61ae233eb487c80df /generic/tclTest.c
parent6d7cd4ec5de7d8e50e829fb37492ab7ca3a2f43a (diff)
downloadtcl-f5c319ed1e839e9256fcad85b69c4fde1d5d7c97.zip
tcl-f5c319ed1e839e9256fcad85b69c4fde1d5d7c97.tar.gz
tcl-f5c319ed1e839e9256fcad85b69c4fde1d5d7c97.tar.bz2
filesystem fixes for '-force' consistency and picky compilers
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c158
1 files changed, 81 insertions, 77 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 7c9361d..7709bb9 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,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.75 2004/01/21 19:59:33 vincentdarley Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.76 2004/01/29 10:28:20 vincentdarley Exp $
*/
#define TCL_TEST
@@ -422,7 +422,11 @@ 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_Obj *pathPtr));
+static Tcl_Obj* SimpleRedirect _ANSI_ARGS_ ((Tcl_Obj *pathPtr));
+static int SimpleMatchInDirectory _ANSI_ARGS_ ((
+ Tcl_Interp *interp, Tcl_Obj *resultPtr,
+ Tcl_Obj *dirPtr, CONST char *pattern,
+ Tcl_GlobTypeData *types));
static int TestNumUtfCharsCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -485,7 +489,7 @@ static Tcl_Filesystem simpleFilesystem = {
&SimpleStat,
&SimpleAccess,
&SimpleOpenFileChannel,
- NULL,
+ &SimpleMatchInDirectory,
NULL,
/* We choose not to support symbolic links inside our vfs's */
NULL,
@@ -6320,34 +6324,22 @@ SimplePathInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) {
}
/*
- * 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;
-/* We use this to ensure we clean up after ourselves */
-static Tcl_Obj *tempFile = NULL;
-
-/*
- * This is a very 'hacky' filesystem which is used just to
- * test two important features of the vfs code: (1) that
- * you can load a shared library from a vfs, (2) that when
- * copying files from one fs to another, the 'mtime' is
- * preserved.
+ * This is a slightly 'hacky' filesystem which is used just to test a
+ * few important features of the vfs code: (1) that you can load a
+ * shared library from a vfs, (2) that when copying files from one fs to
+ * another, the 'mtime' is preserved. (3) that recursive
+ * cross-filesystem directory copies have the correct behaviour
+ * with/without -force.
*
- * It treats any file in 'simplefs:/' as a file, and
- * artificially creates a real file on the fly which it uses
- * to extract information from. The real file it uses is
+ * It treats any file in 'simplefs:/' as a file, which it
+ * routes to the current directory. The real file it uses is
* whatever follows the trailing '/' (e.g. 'foo' in 'simplefs:/foo'),
- * and that file is assumed to exist in the native pwd, and is
- * copied over to the native temporary directory where it is
- * accessed.
+ * and that file exists or not according to what is in the native
+ * pwd.
*
* Please do not consider this filesystem a model of how
* things are to be done. It is quite the opposite! But, it
- * does allow us to test two important features.
- *
- * Finally: this fs can only be used from one interpreter.
+ * does allow us to test some important features.
*/
static int
TestSimpleFilesystemObjCmd(dummy, interp, objc, objv)
@@ -6369,54 +6361,81 @@ TestSimpleFilesystemObjCmd(dummy, interp, objc, objv)
if (boolVal) {
res = Tcl_FSRegister((ClientData)interp, &simpleFilesystem);
msg = (res == TCL_OK) ? "registered" : "failed";
- simpleInterpPtr = interp;
} else {
- if (tempFile != NULL) {
- Tcl_FSDeleteFile(tempFile);
- Tcl_DecrRefCount(tempFile);
- tempFile = NULL;
- }
res = Tcl_FSUnregister(&simpleFilesystem);
msg = (res == TCL_OK) ? "unregistered" : "failed";
- simpleInterpPtr = NULL;
}
Tcl_SetResult(interp, msg, TCL_VOLATILE);
return res;
}
/*
- * 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.
+ * Treats a file name 'simplefs:/foo' by using the file 'foo'
+ * in the current (native) directory.
*/
static Tcl_Obj*
-SimpleCopy(pathPtr)
+SimpleRedirect(pathPtr)
Tcl_Obj *pathPtr; /* Name of file to copy. */
{
- int res;
+ int len;
CONST char *str;
Tcl_Obj *origPtr;
- Tcl_Obj *tempPtr;
-
- tempPtr = TclpTempFileName();
- Tcl_IncrRefCount(tempPtr);
/*
* We assume the same name in the current directory is ok.
*/
- str = Tcl_GetString(pathPtr);
+ str = Tcl_GetStringFromObj(pathPtr, &len);
+ if (len < 10 || strncmp(str, "simplefs:/", 10)) {
+ /* Probably shouldn't ever reach here */
+ Tcl_IncrRefCount(pathPtr);
+ return pathPtr;
+ }
origPtr = Tcl_NewStringObj(str+10,-1);
Tcl_IncrRefCount(origPtr);
+ return origPtr;
+}
- res = TclCrossFilesystemCopy(simpleInterpPtr, origPtr, tempPtr);
- Tcl_DecrRefCount(origPtr);
+static int
+SimpleMatchInDirectory(interp, resultPtr, dirPtr, pattern, types)
+ Tcl_Interp *interp; /* Interpreter for error
+ * messages. */
+ Tcl_Obj *resultPtr; /* Object to lappend results. */
+ Tcl_Obj *dirPtr; /* Contains path to directory to search. */
+ CONST char *pattern; /* Pattern to match against. */
+ Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
+ * May be NULL. */
+{
+ int res;
+ Tcl_Obj *origPtr;
+ Tcl_Obj *resPtr;
- if (res != TCL_OK) {
- Tcl_FSDeleteFile(tempPtr);
- Tcl_DecrRefCount(tempPtr);
- return NULL;
+ /* We only provide a new volume, therefore no mounts at all */
+ if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
+ return TCL_OK;
}
- return tempPtr;
+
+ /*
+ * We assume the same name in the current directory is ok.
+ */
+ resPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(resPtr);
+ origPtr = SimpleRedirect(dirPtr);
+ Tcl_IncrRefCount(origPtr);
+ res = Tcl_FSMatchInDirectory(interp, resPtr, origPtr, pattern, types);
+ if (res == TCL_OK) {
+ int gLength, j;
+ Tcl_ListObjLength(NULL, resPtr, &gLength);
+ for (j = 0; j < gLength; j++) {
+ Tcl_Obj *gElt, *nElt;
+ Tcl_ListObjIndex(NULL, resPtr, j, &gElt);
+ nElt = Tcl_NewStringObj("simplefs:/",10);
+ Tcl_AppendObjToObj(nElt, gElt);
+ Tcl_ListObjAppendElement(NULL, resultPtr, nElt);
+ }
+ }
+ Tcl_DecrRefCount(origPtr);
+ Tcl_DecrRefCount(resPtr);
+ return res;
}
static Tcl_Channel
@@ -6438,24 +6457,11 @@ SimpleOpenFileChannel(interp, pathPtr, mode, permissions)
return NULL;
}
- tempPtr = SimpleCopy(pathPtr);
-
- if (tempPtr == NULL) {
- return NULL;
- }
+ tempPtr = SimpleRedirect(pathPtr);
chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions);
- if (tempFile != NULL) {
- Tcl_FSDeleteFile(tempFile);
- Tcl_DecrRefCount(tempFile);
- tempFile = NULL;
- }
- /*
- * Store file pointer in this global variable so we can delete
- * it later
- */
- tempFile = tempPtr;
+ Tcl_DecrRefCount(tempPtr);
return chan;
}
@@ -6464,8 +6470,11 @@ SimpleAccess(pathPtr, mode)
Tcl_Obj *pathPtr; /* Path of file to access (in current CP). */
int mode; /* Permission setting. */
{
- /* All files exist */
- return TCL_OK;
+ int res;
+ Tcl_Obj *tempPtr = SimpleRedirect(pathPtr);
+ res = Tcl_FSAccess(tempPtr, mode);
+ Tcl_DecrRefCount(tempPtr);
+ return res;
}
static int
@@ -6473,16 +6482,11 @@ SimpleStat(pathPtr, bufPtr)
Tcl_Obj *pathPtr; /* Path of file to stat (in current CP). */
Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */
{
- Tcl_Obj *tempPtr = SimpleCopy(pathPtr);
- if (tempPtr == NULL) {
- /* We just pretend the file exists anyway */
- return TCL_OK;
- } else {
- int res = Tcl_FSStat(tempPtr, bufPtr);
- Tcl_FSDeleteFile(tempPtr);
- Tcl_DecrRefCount(tempPtr);
- return res;
- }
+ int res;
+ Tcl_Obj *tempPtr = SimpleRedirect(pathPtr);
+ res = Tcl_FSStat(tempPtr, bufPtr);
+ Tcl_DecrRefCount(tempPtr);
+ return res;
}
static Tcl_Obj*