summaryrefslogtreecommitdiffstats
path: root/unix
diff options
context:
space:
mode:
authorsurles <surles>1998-08-04 11:50:23 (GMT)
committersurles <surles>1998-08-04 11:50:23 (GMT)
commit76b7ca72cf1d6d56aed42299bd11ac04c301264b (patch)
treec5d5b48fd37a931bfcd76ba3d740c4ec7ef2397e /unix
parent65e105be5425dda4dba7582b6c29ff2ef3ce0f1d (diff)
downloadtcl-76b7ca72cf1d6d56aed42299bd11ac04c301264b.zip
tcl-76b7ca72cf1d6d56aed42299bd11ac04c301264b.tar.gz
tcl-76b7ca72cf1d6d56aed42299bd11ac04c301264b.tar.bz2
Added the testalarm command.
Diffstat (limited to 'unix')
-rw-r--r--unix/tclUnixTest.c183
1 files changed, 183 insertions, 0 deletions
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index cbc2639..835b5e5 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -15,6 +15,16 @@
#include "tclPort.h"
/*
+ * The headers are needed for the testalarm command that verifies the
+ * EINITR bug has been fixed (Handling of this signal was forgotten after
+ * Tcl7.4.)
+ */
+
+#include <tcl.h>
+#include <signal.h>
+#include <sys/resource.h>
+
+/*
* The following macros convert between TclFile's and fd's. The conversion
* simple involves shifting fd's up by one to ensure that no valid fd is ever
* the same as NULL. Note that this code is duplicated from tclUnixPipe.c
@@ -45,6 +55,12 @@ typedef struct Pipe {
static Pipe testPipes[MAX_PIPES];
/*
+ * The var below is used by the testalarm command.
+ */
+
+static Tcl_AsyncHandler sigToken;
+
+/*
* Forward declarations of procedures defined later in this file:
*/
@@ -59,6 +75,13 @@ static int TestfindexecutableCmd _ANSI_ARGS_((ClientData dummy,
static int TestgetopenfileCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
+static int TestalarmCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+void AlarmHandler _ANSI_ARGS_(());
+int HandleAlarmSignal _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int code));
+static void CleanupAlarmAssocData _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp));
/*
*----------------------------------------------------------------------
@@ -89,6 +112,8 @@ TclplatformtestInit(interp)
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
@@ -475,3 +500,161 @@ TestgetopenfileCmd(clientData, interp, argc, argv)
}
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ * TestalarmCmd --
+ *
+ * Test that EINTR is handled correctly by generating and
+ * handling a signal. This was handled correctly in Tcl7.4
+ * but was lost when channel drivers were created.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * Sets up an signal and async handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TestalarmCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ char *cmd;
+ char *oldData;
+ Tcl_InterpDeleteProc *procPtr;
+ unsigned int sec;
+ RETSIGTYPE (*oldhandler)();
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " script ?seconds?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ cmd = ckalloc((unsigned) strlen(argv[1]) + 1);
+ strcpy(cmd, argv[1]);
+ if (argc > 2) {
+ Tcl_GetInt(interp, argv[2], (int *)&sec);
+ } else {
+ sec = 1;
+ }
+
+ /*
+ * If we previously associated a malloced value with the variable,
+ * free it before associating a new value.
+ */
+
+ oldData = (char *) Tcl_GetAssocData(interp, argv[1], &procPtr);
+ if ((oldData != NULL) && (procPtr == CleanupAlarmAssocData)) {
+ ckfree(oldData);
+ }
+
+ /*
+ * Store the command to execute when the signal is generated.
+ */
+
+ Tcl_SetAssocData(interp, "alarmCmd", CleanupAlarmAssocData,
+ (ClientData) cmd);
+
+ /*
+ * Setup the signal handling.
+ */
+
+ oldhandler = signal(SIGALRM, AlarmHandler);
+ if ((int)oldhandler == -1) {
+ Tcl_AppendResult(interp, "signal: ", Tcl_PosixError(interp), NULL);
+ return TCL_ERROR;
+ }
+ sigToken = Tcl_AsyncCreate(HandleAlarmSignal, NULL);
+ if (alarm(sec) < 0) {
+ Tcl_AppendResult(interp, "alarm: ", Tcl_PosixError(interp), NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AlarmHandler --
+ *
+ * Signal handler for the alarm command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Calls the Tcl Async handler.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+AlarmHandler()
+{
+ Tcl_AsyncMark(sigToken);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleAlarmSignal --
+ *
+ * The async callback from Tcl that calls the alarm command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+HandleAlarmSignal(clientData, interp, code)
+ ClientData clientData; /* Data to be released. */
+ Tcl_Interp *interp; /* Interpreter being deleted. */
+ int code;
+{
+ char *cmd;
+
+ cmd = (char *) Tcl_GetAssocData(interp, "alarmCmd", NULL);
+ if (cmd != NULL) {
+ Tcl_GlobalEval(interp, cmd);
+ return TCL_OK;
+ } else {
+ Tcl_AppendResult(interp, "alarm assoc data is NULL", (char *) NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanupAlarmAssocData --
+ *
+ * This function is called when an interpreter is deleted to clean
+ * up any data left over from running the testalarm command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Releases storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CleanupAlarmAssocData(clientData, interp)
+ ClientData clientData; /* Data to be released. */
+ Tcl_Interp *interp; /* Interpreter being deleted. */
+{
+ ckfree((char *) clientData);
+}