summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2001-07-31 19:12:05 (GMT)
committervincentdarley <vincentdarley>2001-07-31 19:12:05 (GMT)
commitc1335a91a0a2d1b2b776c7bbb5763b90e3d629ad (patch)
tree1ec44ca71eb2e561881490f7766175daa65dc9eb /generic/tclTest.c
parent2414705dd748a119ffa0a2976ed71abc283aff11 (diff)
downloadtcl-c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad.zip
tcl-c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad.tar.gz
tcl-c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad.tar.bz2
Changes from TIP#17 "Redo Tcl's filesystem"
The following files were impacted. * doc/Access.3: * doc/FileSystem.3: * doc/OpenFileChnl.3: * doc/file.n: * doc/glob.n: * generic/tcl.decls: * generic/tcl.h: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclDate.c: * generic/tclDecls.h: * generic/tclEncoding.c: * generic/tclFCmd.c: * generic/tclFileName.c: * generic/tclGetDate.y: * generic/tclIO.c: * generic/tclIOCmd.c: * generic/tclIOUtil.c: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclLoad.c: * generic/tclStubInit.c: * generic/tclTest.c: * generic/tclUtil.c: * library/init.tcl: * mac/tclMacFCmd.c: * mac/tclMacFile.c: * mac/tclMacInit.c: * mac/tclMacPort.h: * mac/tclMacResource.c: * mac/tclMacTime.c: * tests/cmdAH.test: * tests/event.test: * tests/fCmd.test: * tests/fileName.test: * tests/io.test: * tests/ioCmd.test: * tests/proc-old.test: * tests/registry.test: * tests/unixFCmd.test: * tests/winDde.test: * tests/winFCmd.test: * unix/mkLinks: * unix/tclUnixFCmd.c: * unix/tclUnixFile.c: * unix/tclUnixInit.c: * unix/tclUnixPipe.c: * win/tclWinFCmd.c: * win/tclWinFile.c: * win/tclWinInit.c: * win/tclWinPipe.c
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c404
1 files changed, 400 insertions, 4 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 8c3ae5c..08925bd 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.25 2001/04/04 17:35:25 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.26 2001/07/31 19:12:06 vincentdarley Exp $
*/
#define TCL_TEST
@@ -301,7 +301,73 @@ static int TestChannelCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
static int TestChannelEventCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
+/* Filesystem testing */
+static int TestFilesystemObjCmd _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 Tcl_FSStatProc TestReportStat;
+static Tcl_FSAccessProc TestReportAccess;
+static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel;
+static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory;
+static Tcl_FSGetCwdProc TestReportGetCwd;
+static Tcl_FSChdirProc TestReportChdir;
+static Tcl_FSLstatProc TestReportLstat;
+static Tcl_FSCopyFileProc TestReportCopyFile;
+static Tcl_FSDeleteFileProc TestReportDeleteFile;
+static Tcl_FSRenameFileProc TestReportRenameFile;
+static Tcl_FSCreateDirectoryProc TestReportCreateDirectory;
+static Tcl_FSCopyDirectoryProc TestReportCopyDirectory;
+static Tcl_FSRemoveDirectoryProc TestReportRemoveDirectory;
+static Tcl_FSLoadFileProc TestReportLoadFile;
+static Tcl_FSUnloadFileProc TestReportUnloadFile;
+static Tcl_FSReadlinkProc TestReportReadlink;
+static Tcl_FSListVolumesProc TestReportListVolumes;
+static Tcl_FSFileAttrStringsProc TestReportFileAttrStrings;
+static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet;
+static Tcl_FSFileAttrsSetProc TestReportFileAttrsSet;
+static Tcl_FSUtimeProc TestReportUtime;
+static Tcl_FSNormalizePathProc TestReportNormalizePath;
+
+static Tcl_Filesystem testReportingFilesystem = {
+ "reporting",
+ sizeof(Tcl_Filesystem),
+ TCL_FILESYSTEM_VERSION_1,
+ NULL, /* path in */
+ NULL, /* native dup */
+ NULL, /* native free */
+ NULL, /* native to norm */
+ NULL, /* convert to native */
+ &TestReportNormalizePath,
+ NULL, /* path type */
+ NULL, /* separator */
+ &TestReportStat,
+ &TestReportAccess,
+ &TestReportOpenFileChannel,
+ &TestReportMatchInDirectory,
+ &TestReportUtime,
+ &TestReportReadlink,
+ &TestReportListVolumes,
+ &TestReportFileAttrStrings,
+ &TestReportFileAttrsGet,
+ &TestReportFileAttrsSet,
+ &TestReportCreateDirectory,
+ &TestReportRemoveDirectory,
+ &TestReportDeleteFile,
+ &TestReportLstat,
+ &TestReportCopyFile,
+ &TestReportRenameFile,
+ &TestReportCopyDirectory,
+ &TestReportLoadFile,
+ &TestReportUnloadFile,
+ &TestReportGetCwd,
+ &TestReportChdir
+};
+
+
/*
* External (platform specific) initialization routine, these declarations
* explicitly don't use EXTERN since this code does not get compiled
@@ -352,6 +418,8 @@ Tcltest_Init(interp)
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
TestGetIndexFromObjStructObjCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
@@ -4269,10 +4337,18 @@ TestOpenFileChannelProc1(interp, fileName, modeString, permissions)
* file, with what modes to create
* it? */
{
- if (!strcmp("testOpenFileChannel1%.fil", fileName)) {
+ char *expectname="testOpenFileChannel1%.fil";
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+ Tcl_JoinPath(1, &expectname, &ds);
+
+ if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
+ Tcl_DStringFree(&ds);
return (TclpOpenFileChannel(interp, "__testOpenFileChannel1%__.fil",
modeString, permissions));
} else {
+ Tcl_DStringFree(&ds);
return (NULL);
}
}
@@ -4289,10 +4365,18 @@ TestOpenFileChannelProc2(interp, fileName, modeString, permissions)
* file, with what modes to create
* it? */
{
- if (!strcmp("testOpenFileChannel2%.fil", fileName)) {
+ char *expectname="testOpenFileChannel2%.fil";
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+ Tcl_JoinPath(1, &expectname, &ds);
+
+ if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
+ Tcl_DStringFree(&ds);
return (TclpOpenFileChannel(interp, "__testOpenFileChannel2%__.fil",
modeString, permissions));
} else {
+ Tcl_DStringFree(&ds);
return (NULL);
}
}
@@ -4309,10 +4393,18 @@ TestOpenFileChannelProc3(interp, fileName, modeString, permissions)
* file, with what modes to create
* it? */
{
- if (!strcmp("testOpenFileChannel3%.fil", fileName)) {
+ char *expectname="testOpenFileChannel3%.fil";
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+ Tcl_JoinPath(1, &expectname, &ds);
+
+ if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
+ Tcl_DStringFree(&ds);
return (TclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil",
modeString, permissions));
} else {
+ Tcl_DStringFree(&ds);
return (NULL);
}
}
@@ -4535,6 +4627,17 @@ TestChannelCmd(clientData, interp, argc, argv)
return TCL_OK;
}
+ if ((cmdName[0] == 'i') && (strncmp(cmdName, "isstandard", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ TclFormatInt(buf, Tcl_IsStandardChannel(chan));
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ return TCL_OK;
+ }
+
if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
if (argc != 3) {
Tcl_AppendResult(interp, "channel name required",
@@ -5053,3 +5156,296 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
Tcl_WrongNumArgs(interp, 3, objv, NULL);
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestFilesystemObjCmd --
+ *
+ * This procedure implements the "testfilesystem" command. It is
+ * used to test Tcl_FSRegister, Tcl_FSUnregister, and can be used
+ * to test that the pluggable filesystem works.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Inserts or removes a filesystem from Tcl's stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestFilesystemObjCmd(dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ int res;
+ int onOff;
+
+ if (objc != 2) {
+ char *cmd = Tcl_GetString(objv[0]);
+ Tcl_AppendResult(interp, "wrong # args: should be \"", cmd,
+ " (1 or 0)\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[1], &onOff) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (onOff) {
+ res = Tcl_FSRegister((ClientData)interp, &testReportingFilesystem);
+ if (res == TCL_OK) {
+ Tcl_SetResult(interp, "registered", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "failed", TCL_STATIC);
+ }
+ } else {
+ res = Tcl_FSUnregister(&testReportingFilesystem);
+ if (res == TCL_OK) {
+ Tcl_SetResult(interp, "unregistered", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "failed", TCL_STATIC);
+ }
+ }
+ return res;
+}
+
+void
+TestReport(cmd, arg1, arg2)
+ CONST char* cmd;
+ Tcl_Obj* arg1;
+ Tcl_Obj* arg2;
+{
+ Tcl_Interp* interp = (Tcl_Interp*) Tcl_FSData(&testReportingFilesystem);
+ if (interp == NULL) {
+ /* This is bad, but not much we can do about it */
+ } else {
+ Tcl_SavedResult savedResult;
+ Tcl_DString ds;
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, "puts stderr ",-1);
+ Tcl_DStringStartSublist(&ds);
+ Tcl_DStringAppendElement(&ds, cmd);
+ if (arg1 != NULL) {
+ Tcl_DStringAppendElement(&ds, Tcl_GetString(arg1));
+ }
+ if (arg2 != NULL) {
+ Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));
+ }
+ Tcl_DStringEndSublist(&ds);
+ Tcl_SaveResult(interp, &savedResult);
+ Tcl_Eval(interp, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ Tcl_RestoreResult(interp, &savedResult);
+ }
+}
+int
+TestReportStat(path, buf)
+ Tcl_Obj *path; /* Path of file to stat (in current CP). */
+ struct stat *buf; /* Filled with results of stat call. */
+{
+ TestReport("stat",path, NULL);
+ return -1;
+}
+int
+TestReportLstat(path, buf)
+ Tcl_Obj *path; /* Path of file to stat (in current CP). */
+ struct stat *buf; /* Filled with results of stat call. */
+{
+ TestReport("lstat",path, NULL);
+ return -1;
+}
+int
+TestReportAccess(path, mode)
+ Tcl_Obj *path; /* Path of file to access (in current CP). */
+ int mode; /* Permission setting. */
+{
+ TestReport("access",path,NULL);
+ return -1;
+}
+Tcl_Channel
+TestReportOpenFileChannel(interp, fileName, modeString, permissions)
+ Tcl_Interp *interp; /* Interpreter for error reporting;
+ * can be NULL. */
+ Tcl_Obj *fileName; /* Name of file to open. */
+ char *modeString; /* A list of POSIX open modes or
+ * a string such as "rw". */
+ int permissions; /* If the open involves creating a
+ * file, with what modes to create
+ * it? */
+{
+ TestReport("open",fileName, NULL);
+ return NULL;
+}
+
+int
+TestReportMatchInDirectory(interp, resultPtr, dirPtr, pattern, types)
+ Tcl_Interp *interp; /* Interpreter to receive results. */
+ Tcl_Obj *resultPtr; /* Directory separators to pass to TclDoGlob. */
+ Tcl_Obj *dirPtr; /* Contains path to directory to search. */
+ char *pattern; /* Pattern to match against. */
+ Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
+ * May be NULL. */
+{
+ TestReport("matchindirectory",dirPtr, NULL);
+ return -1;
+}
+Tcl_Obj *
+TestReportGetCwd(interp)
+ Tcl_Interp *interp;
+{
+ TestReport("cwd",NULL,NULL);
+ return NULL;
+}
+int
+TestReportChdir(dirName)
+ Tcl_Obj *dirName;
+{
+ TestReport("chdir",dirName,NULL);
+ return -1;
+}
+int
+TestReportLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Obj *fileName; /* Name of the file containing the desired
+ * code. */
+ char *sym1, *sym2; /* Names of two procedures to look up in
+ * the file's symbol table. */
+ Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+ /* Where to return the addresses corresponding
+ * to sym1 and sym2. */
+ ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * TclpUnloadFile() to unload the file. */
+{
+ TestReport("loadfile",fileName,NULL);
+ return -1;
+}
+void
+TestReportUnloadFile(clientData)
+ ClientData clientData; /* ClientData returned by a previous call
+ * to TclpLoadFile(). The clientData is
+ * a token that represents the loaded
+ * file. */
+{
+ TestReport("unloadfile",NULL,NULL);
+}
+Tcl_Obj *
+TestReportReadlink(path)
+ Tcl_Obj *path; /* Path of file to readlink (UTF-8). */
+{
+ TestReport("readlink",path,NULL);
+ return NULL;
+}
+int
+TestReportListVolumes(interp)
+ Tcl_Interp *interp; /* Interpreter for returning volume list. */
+{
+ TestReport("listvolumes",NULL,NULL);
+ return TCL_OK;
+}
+int
+TestReportRenameFile(src, dst)
+ Tcl_Obj *src; /* Pathname of file or dir to be renamed
+ * (UTF-8). */
+ Tcl_Obj *dst; /* New pathname of file or directory
+ * (UTF-8). */
+{
+ TestReport("renamefile",src,dst);
+ return -1;
+}
+int
+TestReportCopyFile(src, dst)
+ Tcl_Obj *src; /* Pathname of file to be copied (UTF-8). */
+ Tcl_Obj *dst; /* Pathname of file to copy to (UTF-8). */
+{
+ TestReport("copyfile",src,dst);
+ return -1;
+}
+int
+TestReportDeleteFile(path)
+ Tcl_Obj *path; /* Pathname of file to be removed (UTF-8). */
+{
+ TestReport("deletefile",path,NULL);
+ return -1;
+}
+int
+TestReportCreateDirectory(path)
+ Tcl_Obj *path; /* Pathname of directory to create (UTF-8). */
+{
+ TestReport("createdirectory",path,NULL);
+ return -1;
+}
+int
+TestReportCopyDirectory(src, dst, errorPtr)
+ Tcl_Obj *src; /* Pathname of directory to be copied
+ * (UTF-8). */
+ Tcl_Obj *dst; /* Pathname of target directory (UTF-8). */
+ Tcl_Obj **errorPtr; /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
+{
+ TestReport("copydirectory",src,dst);
+ return -1;
+}
+int
+TestReportRemoveDirectory(path, recursive, errorPtr)
+ Tcl_Obj *path; /* Pathname of directory to be removed
+ * (UTF-8). */
+ int recursive; /* If non-zero, removes directories that
+ * are nonempty. Otherwise, will only remove
+ * empty directories. */
+ Tcl_Obj **errorPtr; /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
+{
+ TestReport("removedirectory",path,NULL);
+ return -1;
+}
+char**
+TestReportFileAttrStrings(fileName, objPtrRef)
+ Tcl_Obj* fileName;
+ Tcl_Obj** objPtrRef;
+{
+ TestReport("fileattributestrings",fileName,NULL);
+ return NULL;
+}
+int
+TestReportFileAttrsGet(interp, index, fileName, objPtrRef)
+ Tcl_Interp *interp; /* The interpreter for error reporting. */
+ int index; /* index of the attribute command. */
+ Tcl_Obj *fileName; /* filename we are operating on. */
+ Tcl_Obj **objPtrRef; /* for output. */
+{
+ TestReport("fileattributesget",fileName,NULL);
+ return -1;
+}
+int
+TestReportFileAttrsSet(interp, index, fileName, objPtr)
+ Tcl_Interp *interp; /* The interpreter for error reporting. */
+ int index; /* index of the attribute command. */
+ Tcl_Obj *fileName; /* filename we are operating on. */
+ Tcl_Obj *objPtr; /* for input. */
+{
+ TestReport("fileattributesset",fileName,objPtr);
+ return -1;
+}
+int
+TestReportUtime (fileName, tval)
+ Tcl_Obj* fileName;
+ struct utimbuf *tval;
+{
+ TestReport("utime",fileName,NULL);
+ return -1;
+}
+int
+TestReportNormalizePath(interp, pathPtr, nextCheckpoint)
+ Tcl_Interp *interp;
+ Tcl_Obj *pathPtr;
+ int nextCheckpoint;
+{
+ TestReport("normalizepath",pathPtr,NULL);
+ return nextCheckpoint;
+}