Upgrade the capabilities of time limits by allowing them to fire in the midst

of the processing of the event loop or during a blocking [after]. [Bug 1085023]

1 files changed, 60 insertions, 3 deletions

diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index f6f53f2..4521b50 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInterp.c,v 1.54 2004/12/02 15:31:28 dkf Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.55 2004/12/16 19:36:34 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -246,6 +246,7 @@ static void		DeleteScriptLimitCallback _ANSI_ARGS_((
 			    ClientData clientData));
 static void		RunLimitHandlers _ANSI_ARGS_((LimitHandler *handlerPtr,
 			    Tcl_Interp *interp));
+static void		TimeLimitCallback _ANSI_ARGS_((ClientData clientData));
 
 
 /*
@@ -2946,7 +2947,7 @@ Tcl_MakeSafe(interp)
  *
  * Tcl_LimitExceeded --
  *
- *	Tests whether any limit has been exceededin the given
+ *	Tests whether any limit has been exceeded in the given
  *	interpreter (i.e. whether the interpreter is currently unable
  *	to process further scripts).
  *
@@ -3073,7 +3074,7 @@ Tcl_LimitCheck(interp)
 	    iPtr->limit.exceeded |= TCL_LIMIT_TIME;
 	    Tcl_Preserve(interp);
 	    RunLimitHandlers(iPtr->limit.timeHandlers, interp);
-	    if (iPtr->limit.time.sec >= now.sec ||
+	    if (iPtr->limit.time.sec > now.sec ||
 		    (iPtr->limit.time.sec == now.sec &&
 		    iPtr->limit.time.usec >= now.usec)) {
 		iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
@@ -3415,6 +3416,16 @@ TclLimitRemoveAllHandlers(interp)
 	    ckfree((char *) handlerPtr);
 	}
     }
+
+    /*
+     * Delete the timer callback that is used to trap limits that
+     * occur in [vwait]s...
+     */
+
+    if (iPtr->limit.timeEvent != NULL) {
+	Tcl_DeleteTimerHandler(iPtr->limit.timeEvent);
+	iPtr->limit.timeEvent = NULL;
+    }
 }
 
 /*
@@ -3611,14 +3622,59 @@ Tcl_LimitSetTime(interp, timeLimitPtr)
     Tcl_Time *timeLimitPtr;
 {
     Interp *iPtr = (Interp *) interp;
+    Tcl_Time nextMoment;
 
     memcpy(&iPtr->limit.time, timeLimitPtr, sizeof(Tcl_Time));
+    if (iPtr->limit.timeEvent != NULL) {
+	Tcl_DeleteTimerHandler(iPtr->limit.timeEvent);
+    }
+    nextMoment.sec = timeLimitPtr->sec;
+    nextMoment.usec = timeLimitPtr->usec+10;
+    if (nextMoment.usec >= 1000000) {
+	nextMoment.sec++;
+	nextMoment.usec -= 1000000;
+    }
+    iPtr->limit.timeEvent = TclCreateAbsoluteTimerHandler(&nextMoment,
+	    TimeLimitCallback, (ClientData) interp);
     iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
 }
 
 /*
  *----------------------------------------------------------------------
  *
+ * TimeLimitCallback --
+ *
+ *	Callback that allows time limits to be enforced even when
+ *	doing a blocking wait for events.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May put the interpreter into a state where it can no longer
+ *	execute commands. May make callbacks into other interpreters.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimeLimitCallback(clientData)
+    ClientData clientData;
+{
+    Tcl_Interp *interp = (Tcl_Interp *) clientData;
+
+    Tcl_Preserve((ClientData) interp);
+    ((Interp *)interp)->limit.timeEvent = NULL;
+    if (Tcl_LimitCheck(interp) != TCL_OK) {
+	Tcl_AddErrorInfo(interp, "\n    (while waiting for event)");
+	Tcl_BackgroundError(interp);
+    }
+    Tcl_Release((ClientData) interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_LimitGetTime --
  *
  *	Get the current time limit.
@@ -3928,6 +3984,7 @@ TclInitLimitSupport(interp)
     iPtr->limit.cmdGranularity = 1;
     memset(&iPtr->limit.time, 0, sizeof(Tcl_Time));
     iPtr->limit.timeHandlers = NULL;
+    iPtr->limit.timeEvent = NULL;
     iPtr->limit.timeGranularity = 10;
     Tcl_InitHashTable(&iPtr->limit.callbacks,
 	    sizeof(struct ScriptLimitCallbackKey)/sizeof(int));