diff options
Diffstat (limited to 'unix/tclUnixTest.c')
| -rw-r--r-- | unix/tclUnixTest.c | 166 |
1 files changed, 111 insertions, 55 deletions
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 0d79e47..722ded9 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -6,13 +6,10 @@ * Copyright (c) 1996-1997 Sun Microsystems, Inc. * Copyright (c) 1998 by Scriptics Corporation. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#ifndef USE_TCL_STUBS -# define USE_TCL_STUBS -#endif #include "tclInt.h" /* @@ -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; } @@ -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,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++; @@ -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; @@ -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,62 @@ 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; + } + /* 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; +} /* *---------------------------------------------------------------------- @@ -549,7 +605,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 +639,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 +718,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,7 +749,7 @@ 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; @@ -712,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) { |