diff options
Diffstat (limited to 'unix/tclUnixTest.c')
| -rw-r--r-- | unix/tclUnixTest.c | 187 |
1 files changed, 116 insertions, 71 deletions
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index c10225d..39cddef 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -10,9 +10,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#ifndef USE_TCL_STUBS -# define USE_TCL_STUBS -#endif #include "tclInt.h" /* @@ -38,8 +35,8 @@ */ typedef struct Pipe { - TclFile readFile; /* File handle for reading from the pipe. NULL - * means pipe doesn't exist yet. */ + TclFile readFile; /* File handle for reading from the pipe. + * NULL means pipe doesn't exist yet. */ TclFile writeFile; /* File handle for writing from the pipe. */ int readCount; /* Number of times the file handler for this * file has triggered and the file was @@ -56,23 +53,35 @@ static Pipe testPipes[MAX_PIPES]; * The stuff below is used by the testalarm and testgotsig ommands. */ -static const char *gotsig = "0"; +static char *gotsig = "0"; /* * Forward declarations of functions defined later in this file: */ -static Tcl_CmdProc TestalarmCmd; -static Tcl_CmdProc TestchmodCmd; -static Tcl_CmdProc TestfilehandlerCmd; -static Tcl_CmdProc TestfilewaitCmd; -static Tcl_CmdProc TestfindexecutableCmd; -static Tcl_CmdProc TestgetdefencdirCmd; -static Tcl_CmdProc TestgetopenfileCmd; -static Tcl_CmdProc TestgotsigCmd; -static Tcl_CmdProc TestsetdefencdirCmd; -static Tcl_FileProc TestFileHandlerProc; -static void AlarmHandler(int signum); +static void TestFileHandlerProc(ClientData clientData, int mask); +static int TestfilehandlerCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestfilewaitCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestfindexecutableCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestforkObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST *argv); +static int TestgetopenfileCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestgetdefencdirCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestsetdefencdirCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +int TclplatformtestInit(Tcl_Interp *interp); +static int TestalarmCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestgotsigCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static void AlarmHandler(int signum); +static int TestchmodCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); /* *---------------------------------------------------------------------- @@ -96,23 +105,25 @@ TclplatformtestInit( Tcl_Interp *interp) /* Interpreter to add commands to. */ { Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd, - NULL, NULL); + (ClientData) 0, NULL); + Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd, + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testalarm", TestalarmCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd, - NULL, NULL); + (ClientData) 0, NULL); return TCL_OK; } @@ -138,7 +149,7 @@ TestfilehandlerCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { Pipe *pipePtr; int i, mask, timeout; @@ -160,7 +171,7 @@ TestfilehandlerCmd( if (argc < 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " option ... \"", NULL); + " option ... \"", NULL); return TCL_ERROR; } pipePtr = NULL; @@ -187,7 +198,7 @@ TestfilehandlerCmd( } else if (strcmp(argv[1], "clear") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " clear index\"", NULL); + argv[0], " clear index\"", NULL); return TCL_ERROR; } pipePtr->readCount = pipePtr->writeCount = 0; @@ -196,15 +207,15 @@ TestfilehandlerCmd( if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " counts index\"", NULL); + argv[0], " counts index\"", NULL); return TCL_ERROR; } sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount); - Tcl_AppendResult(interp, buf, NULL); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (strcmp(argv[1], "create") == 0) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " create index readMode writeMode\"", NULL); + argv[0], " create index readMode writeMode\"", NULL); return TCL_ERROR; } if (pipePtr->readFile == NULL) { @@ -217,8 +228,8 @@ TestfilehandlerCmd( fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK); fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK); #else - Tcl_AppendResult(interp, "can't make pipes non-blocking", - NULL); + Tcl_SetResult(interp, "can't make pipes non-blocking", + TCL_STATIC); return TCL_ERROR; #endif } @@ -227,24 +238,24 @@ TestfilehandlerCmd( if (strcmp(argv[3], "readable") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE, - TestFileHandlerProc, pipePtr); + TestFileHandlerProc, (ClientData) pipePtr); } else if (strcmp(argv[3], "off") == 0) { Tcl_DeleteFileHandler(GetFd(pipePtr->readFile)); } else if (strcmp(argv[3], "disabled") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0, - TestFileHandlerProc, pipePtr); + TestFileHandlerProc, (ClientData) pipePtr); } else { Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"", NULL); return TCL_ERROR; } if (strcmp(argv[4], "writable") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE, - TestFileHandlerProc, pipePtr); + TestFileHandlerProc, (ClientData) pipePtr); } else if (strcmp(argv[4], "off") == 0) { Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile)); } else if (strcmp(argv[4], "disabled") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0, - TestFileHandlerProc, pipePtr); + TestFileHandlerProc, (ClientData) pipePtr); } else { Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"", NULL); return TCL_ERROR; @@ -252,42 +263,42 @@ TestfilehandlerCmd( } else if (strcmp(argv[1], "empty") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " empty index\"", NULL); + argv[0], " empty index\"", NULL); return TCL_ERROR; } while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) { - /* Empty loop body. */ + /* Empty loop body. */ } } else if (strcmp(argv[1], "fill") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " fill index\"", NULL); + argv[0], " fill index\"", NULL); return TCL_ERROR; } memset(buffer, 'a', 4000); while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) { - /* Empty loop body. */ + /* Empty loop body. */ } } else if (strcmp(argv[1], "fillpartial") == 0) { char buf[TCL_INTEGER_SPACE]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " fillpartial index\"", NULL); + argv[0], " fillpartial index\"", NULL); return TCL_ERROR; } memset(buffer, 'b', 10); TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10)); - Tcl_AppendResult(interp, buf, NULL); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (strcmp(argv[1], "oneevent") == 0) { Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT); } else if (strcmp(argv[1], "wait") == 0) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " wait index readable|writable timeout\"", NULL); + argv[0], " wait index readable|writable timeout\"", NULL); return TCL_ERROR; } if (pipePtr->readFile == NULL) { @@ -328,7 +339,7 @@ TestFileHandlerProc( int mask) /* Indicates which events happened: * TCL_READABLE or TCL_WRITABLE. */ { - Pipe *pipePtr = clientData; + Pipe *pipePtr = (Pipe *) clientData; if (mask & TCL_READABLE) { pipePtr->readCount++; @@ -360,7 +371,7 @@ TestfilewaitCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { int mask, result, timeout; Tcl_Channel channel; @@ -390,7 +401,7 @@ TestfilewaitCmd( if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, (ClientData*) &data) != TCL_OK) { - Tcl_AppendResult(interp, "couldn't get channel file", NULL); + Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC); return TCL_ERROR; } fd = PTR2INT(data); @@ -429,7 +440,7 @@ TestfindexecutableCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { Tcl_Obj *saveName; @@ -472,22 +483,22 @@ TestgetopenfileCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { ClientData filePtr; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName forWriting\"", NULL); + " channelName forWriting\"", NULL); return TCL_ERROR; } if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr) - == TCL_ERROR) { + == TCL_ERROR) { return TCL_ERROR; } - if (filePtr == NULL) { + if (filePtr == (ClientData) NULL) { Tcl_AppendResult(interp, - "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL); + "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL); return TCL_ERROR; } return TCL_OK; @@ -515,17 +526,60 @@ TestsetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " defaultDir\"", NULL); + " defaultDir\"", NULL); return TCL_ERROR; } Tcl_SetDefaultEncodingDir(argv[1]); return TCL_OK; } + +/* + *---------------------------------------------------------------------- + * + * TestforkObjCmd -- + * + * This function implements the "testfork" command. It is used to + * fork the Tcl process for specific test cases. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestforkObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST *objv) /* Argument strings. */ +{ + pid_t pid; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + pid = fork(); + if (pid == -1) { + Tcl_AppendResult(interp, + "Cannot fork", NULL); + return TCL_ERROR; + } + if (pid==0) { + Tcl_InitNotifier(); + } + Tcl_SetObjResult(interp, Tcl_NewIntObj(pid)); + return TCL_OK; +} /* *---------------------------------------------------------------------- @@ -549,7 +603,7 @@ TestgetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { if (argc != 1) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL); @@ -583,7 +637,7 @@ TestalarmCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { #ifdef SA_RESTART unsigned int sec; @@ -662,7 +716,7 @@ TestgotsigCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { Tcl_AppendResult(interp, gotsig, NULL); gotsig = "0"; @@ -693,13 +747,13 @@ TestchmodCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { int i, mode; char *rest; if (argc < 2) { - usage: + usage: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " mode file ?file ...?", NULL); return TCL_ERROR; @@ -712,7 +766,7 @@ TestchmodCmd( for (i = 2; i < argc; i++) { Tcl_DString buffer; - const char *translated; + CONST char *translated; translated = Tcl_TranslateFileName(interp, argv[i], &buffer); if (translated == NULL) { @@ -727,12 +781,3 @@ TestchmodCmd( } return TCL_OK; } - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * tab-width: 8 - * End: - */ |