summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixTest.c')
-rw-r--r--unix/tclUnixTest.c140
1 files changed, 94 insertions, 46 deletions
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index 916a18c..4b0f369 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -8,10 +8,11 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUnixTest.c,v 1.31 2009/01/09 11:21:46 dkf Exp $
*/
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
/*
@@ -37,8 +38,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
@@ -61,27 +62,18 @@ static const char *gotsig = "0";
* Forward declarations of functions defined later in this file:
*/
-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 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);
+static Tcl_CmdProc TestalarmCmd;
+static Tcl_CmdProc TestchmodCmd;
+static Tcl_CmdProc TestfilehandlerCmd;
+static Tcl_CmdProc TestfilewaitCmd;
+static Tcl_CmdProc TestfindexecutableCmd;
+static Tcl_ObjCmdProc TestforkObjCmd;
+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);
/*
*----------------------------------------------------------------------
@@ -105,23 +97,25 @@ TclplatformtestInit(
Tcl_Interp *interp) /* Interpreter to add commands to. */
{
Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd,
+ NULL, NULL);
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
return TCL_OK;
}
@@ -209,7 +203,7 @@ TestfilehandlerCmd(
return TCL_ERROR;
}
sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_AppendResult(interp, buf, NULL);
} else if (strcmp(argv[1], "create") == 0) {
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
@@ -226,8 +220,8 @@ TestfilehandlerCmd(
fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
#else
- Tcl_SetResult(interp, "can't make pipes non-blocking",
- TCL_STATIC);
+ Tcl_AppendResult(interp, "can't make pipes non-blocking",
+ NULL);
return TCL_ERROR;
#endif
}
@@ -236,24 +230,24 @@ TestfilehandlerCmd(
if (strcmp(argv[3], "readable") == 0) {
Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
- TestFileHandlerProc, (ClientData) pipePtr);
+ TestFileHandlerProc, 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, (ClientData) pipePtr);
+ TestFileHandlerProc, 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, (ClientData) pipePtr);
+ TestFileHandlerProc, 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, (ClientData) pipePtr);
+ TestFileHandlerProc, pipePtr);
} else {
Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"", NULL);
return TCL_ERROR;
@@ -290,7 +284,7 @@ TestfilehandlerCmd(
memset(buffer, 'b', 10);
TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_AppendResult(interp, buf, NULL);
} else if (strcmp(argv[1], "oneevent") == 0) {
Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
} else if (strcmp(argv[1], "wait") == 0) {
@@ -337,7 +331,7 @@ TestFileHandlerProc(
int mask) /* Indicates which events happened:
* TCL_READABLE or TCL_WRITABLE. */
{
- Pipe *pipePtr = (Pipe *) clientData;
+ Pipe *pipePtr = clientData;
if (mask & TCL_READABLE) {
pipePtr->readCount++;
@@ -399,7 +393,7 @@ TestfilewaitCmd(
if (Tcl_GetChannelHandle(channel,
(mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
(ClientData*) &data) != TCL_OK) {
- Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
+ Tcl_AppendResult(interp, "couldn't get channel file", NULL);
return TCL_ERROR;
}
fd = PTR2INT(data);
@@ -494,7 +488,7 @@ TestgetopenfileCmd(
== TCL_ERROR) {
return TCL_ERROR;
}
- if (filePtr == (ClientData) NULL) {
+ if (filePtr == NULL) {
Tcl_AppendResult(interp,
"Tcl_GetOpenFile succeeded but FILE * NULL!", NULL);
return TCL_ERROR;
@@ -535,6 +529,51 @@ TestsetdefencdirCmd(
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;
+}
/*
*----------------------------------------------------------------------
@@ -708,7 +747,7 @@ TestchmodCmd(
char *rest;
if (argc < 2) {
- usage:
+ usage:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" mode file ?file ...?", NULL);
return TCL_ERROR;
@@ -736,3 +775,12 @@ TestchmodCmd(
}
return TCL_OK;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */
generated by cgit v0.12 at 2025-10-20 02:21:31 (GMT)