diff options
Diffstat (limited to 'unix/tclUnixTest.c')
| -rw-r--r-- | unix/tclUnixTest.c | 198 |
1 files changed, 122 insertions, 76 deletions
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 9b62db3..722ded9 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 @@ -62,17 +59,29 @@ static const 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; } @@ -137,8 +148,8 @@ static int TestfilehandlerCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int argc, /* Number of arguments. */ + 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,7 +207,7 @@ 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); @@ -204,7 +215,7 @@ TestfilehandlerCmd( } 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) { @@ -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,30 +263,30 @@ 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; } @@ -287,7 +298,7 @@ TestfilehandlerCmd( } 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++; @@ -359,8 +370,8 @@ static int TestfilewaitCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int argc, /* Number of arguments. */ + CONST char **argv) /* Argument strings. */ { int mask, result, timeout; Tcl_Channel channel; @@ -428,8 +439,8 @@ static int TestfindexecutableCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int argc, /* Number of arguments. */ + CONST char **argv) /* Argument strings. */ { Tcl_Obj *saveName; @@ -471,23 +482,23 @@ static int TestgetopenfileCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int argc, /* Number of arguments. */ + 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; @@ -514,18 +525,63 @@ static int TestsetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int argc, /* Number of arguments. */ + 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; + } + /* Only needed when pthread_atfork is not present, + * should not hurt otherwise. */ + if (pid==0) { + Tcl_InitNotifier(); + } + Tcl_SetObjResult(interp, Tcl_NewIntObj(pid)); + return TCL_OK; +} /* *---------------------------------------------------------------------- @@ -548,8 +604,8 @@ static int TestgetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int argc, /* Number of arguments. */ + CONST char **argv) /* Argument strings. */ { if (argc != 1) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL); @@ -582,8 +638,8 @@ static int TestalarmCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int argc, /* Number of arguments. */ + CONST char **argv) /* Argument strings. */ { #ifdef SA_RESTART unsigned int sec; @@ -661,8 +717,8 @@ static int TestgotsigCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int argc, /* Number of arguments. */ + CONST char **argv) /* Argument strings. */ { Tcl_AppendResult(interp, gotsig, NULL); gotsig = "0"; @@ -692,15 +748,14 @@ static int TestchmodCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int argc, /* Number of arguments. */ + CONST char **argv) /* Argument strings. */ { - size_t i; - int mode; + 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; @@ -713,7 +768,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) { @@ -728,12 +783,3 @@ TestchmodCmd( } return TCL_OK; } - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * tab-width: 8 - * End: - */ |