summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley@noemail.net>2003-01-28 14:52:40 (GMT)
committervincentdarley <vincentdarley@noemail.net>2003-01-28 14:52:40 (GMT)
commit082c36ecaa2ee63d47378c23a9daf5e69e166050 (patch)
treedf684e9d1c3c44044a8e1a18492f61795a8b0e9e /generic/tclTest.c
parentab924776f5c65a07ebd3d8587a970da77c262f8b (diff)
downloadtcl-082c36ecaa2ee63d47378c23a9daf5e69e166050.zip
tcl-082c36ecaa2ee63d47378c23a9daf5e69e166050.tar.gz
tcl-082c36ecaa2ee63d47378c23a9daf5e69e166050.tar.bz2
filesystem bug fix and new test
FossilOrigin-Name: 083e6f570acdb3302c2476b07cacb4dd050cb589
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c186
1 files changed, 183 insertions, 3 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 26bc889..f70f587 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.56 2002/08/05 03:24:41 dgp Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.57 2003/01/28 14:52:50 vincentdarley Exp $
*/
#define TCL_TEST
@@ -334,10 +334,15 @@ static int TestChannelEventCmd _ANSI_ARGS_((ClientData clientData,
static int TestFilesystemObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
+static int TestSimpleFilesystemObjCmd _ANSI_ARGS_((
+ ClientData dummy, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
-static void TestReport _ANSI_ARGS_((CONST char* cmd, Tcl_Obj* arg1, Tcl_Obj* arg2));
+static void TestReport _ANSI_ARGS_ ((CONST char* cmd, Tcl_Obj* arg1,
+ Tcl_Obj* arg2));
-static Tcl_Obj *TestReportGetNativePath(Tcl_Obj* pathObjPtr);
+static Tcl_Obj* TestReportGetNativePath _ANSI_ARGS_ ((
+ Tcl_Obj* pathObjPtr));
static int TestReportStat _ANSI_ARGS_ ((Tcl_Obj *path,
Tcl_StatBuf *buf));
@@ -384,6 +389,18 @@ static int TestReportInFilesystem _ANSI_ARGS_ ((Tcl_Obj *pathPtr, ClientData *c
static void TestReportFreeInternalRep _ANSI_ARGS_ ((ClientData clientData));
static ClientData TestReportDupInternalRep _ANSI_ARGS_ ((ClientData clientData));
+static int SimpleStat _ANSI_ARGS_ ((Tcl_Obj *path,
+ Tcl_StatBuf *buf));
+static int SimpleAccess _ANSI_ARGS_ ((Tcl_Obj *path,
+ int mode));
+static Tcl_Channel SimpleOpenFileChannel _ANSI_ARGS_ ((
+ Tcl_Interp *interp, Tcl_Obj *fileName,
+ int mode, int permissions));
+static Tcl_Obj* SimpleListVolumes _ANSI_ARGS_ ((void));
+static int SimplePathInFilesystem _ANSI_ARGS_ ((
+ Tcl_Obj *pathPtr, ClientData *clientDataPtr));
+
+
static Tcl_Filesystem testReportingFilesystem = {
"reporting",
sizeof(Tcl_Filesystem),
@@ -418,6 +435,53 @@ static Tcl_Filesystem testReportingFilesystem = {
&TestReportChdir
};
+static Tcl_Filesystem simpleFilesystem = {
+ "simple",
+ sizeof(Tcl_Filesystem),
+ TCL_FILESYSTEM_VERSION_1,
+ &SimplePathInFilesystem,
+ NULL,
+ NULL,
+ /* No internal to normalized, since we don't create any
+ * pure 'internal' Tcl_Obj path representations */
+ NULL,
+ /* No create native rep function, since we don't use it
+ * or 'Tcl_FSNewNativePath' */
+ NULL,
+ /* Normalize path isn't needed - we assume paths only have
+ * one representation */
+ NULL,
+ NULL,
+ NULL,
+ &SimpleStat,
+ &SimpleAccess,
+ &SimpleOpenFileChannel,
+ NULL,
+ NULL,
+ /* We choose not to support symbolic links inside our vfs's */
+ NULL,
+ &SimpleListVolumes,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ /* No copy file - fallback will occur at Tcl level */
+ NULL,
+ /* No rename file - fallback will occur at Tcl level */
+ NULL,
+ /* No copy directory - fallback will occur at Tcl level */
+ NULL,
+ /* Use stat for lstat */
+ NULL,
+ /* No load - fallback on core implementation */
+ NULL,
+ /* We don't need a getcwd or chdir - fallback on Tcl's versions */
+ NULL,
+ NULL
+};
+
/*
* External (platform specific) initialization routine, these declarations
@@ -479,6 +543,8 @@ Tcltest_Init(interp)
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
TestGetIndexFromObjStructObjCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
@@ -5677,6 +5743,34 @@ TestFilesystemObjCmd(dummy, interp, objc, objv)
return res;
}
+static int
+TestSimpleFilesystemObjCmd(dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ int res, boolVal;
+ char *msg;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "boolean");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[1], &boolVal) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (boolVal) {
+ res = Tcl_FSRegister((ClientData)interp, &simpleFilesystem);
+ msg = (res == TCL_OK) ? "registered" : "failed";
+ } else {
+ res = Tcl_FSUnregister(&simpleFilesystem);
+ msg = (res == TCL_OK) ? "unregistered" : "failed";
+ }
+ Tcl_SetResult(interp, msg, TCL_VOLATILE);
+ return res;
+}
+
static int
TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr)
{
@@ -5959,3 +6053,89 @@ TestReportNormalizePath(interp, pathPtr, nextCheckpoint)
TestReport("normalizepath",pathPtr,NULL);
return nextCheckpoint;
}
+
+static int
+SimplePathInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) {
+ CONST char *str = Tcl_GetString(pathPtr);
+ if (strncmp(str,"simplefs:/",10)) {
+ return -1;
+ }
+ return TCL_OK;
+}
+
+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, *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_IncrRefCount(tempPtr);
+
+ /*
+ * We assume the same name in the current directory is ok.
+ */
+ str = Tcl_GetString(pathPtr);
+ origPtr = Tcl_NewStringObj(str+10,-1);
+ Tcl_IncrRefCount(origPtr);
+
+ res = TclCrossFilesystemCopy(interp, origPtr, tempPtr);
+
+ Tcl_DecrRefCount(origPtr);
+
+ if (res != TCL_OK) {
+ Tcl_DecrRefCount(tempPtr);
+ return NULL;
+ }
+
+ chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions);
+
+ Tcl_DecrRefCount(tempPtr);
+
+ return chan;
+}
+
+static int
+SimpleAccess(pathPtr, mode)
+ Tcl_Obj *pathPtr; /* Path of file to access (in current CP). */
+ int mode; /* Permission setting. */
+{
+ /* All files exist */
+ return TCL_OK;
+}
+
+static int
+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;
+}
+
+static Tcl_Obj*
+SimpleListVolumes(void)
+{
+ /* Add one new volume */
+ Tcl_Obj *retVal;
+
+ retVal = Tcl_NewStringObj("simplefs:/",-1);
+ Tcl_IncrRefCount(retVal);
+ return retVal;
+}
+