diff options
| -rw-r--r-- | ChangeLog | 20 | ||||
| -rw-r--r-- | generic/tclEvent.c | 6 | ||||
| -rw-r--r-- | generic/tclInt.h | 7 | ||||
| -rw-r--r-- | generic/tclInterp.c | 63 | ||||
| -rw-r--r-- | generic/tclTimer.c | 88 | ||||
| -rw-r--r-- | tests/interp.test | 25 |
6 files changed, 188 insertions, 21 deletions
@@ -1,3 +1,23 @@ +2004-12-16 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclInterp.c (Tcl_LimitSetTime, TimeLimitCallback): + (TclLimitRemoveAllHandlers, TclInitLimitSupport): Set a timer + event to trigger when the time limit runs out. All the time limit + actually does is check to see if the time limit has been exceeded, + but this is enough to fix [Bug 1085023]. + * generic/tclInt.h (struct Interp): Added a field to hold the token + for the timer event handler associated with the current time limit. + * generic/tclEvent.c (Tcl_UpdateObjCmd, Tcl_VwaitObjCmd): Add + error message when limit exceeded. + * tests/interp.test (interp-34.[89]): Check that time limits + handle the two cases reported in [Bug 1085023] + + * generic/tclTimer.c (TclCreateAbsoluteTimerHandler): New internal + function that allows setting a timer handler that will be + triggered at (or after) a specific time instead of at some number + of milliseconds in the future. This is a candidate for future + exposure via a TIP. + 2004-12-15 Miguel Sofer <msofer@users.sf.net> * generic/tclBasic.c: diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 5a734c4..8d4533ec 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.55 2004/12/04 21:19:18 dgp Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.56 2004/12/16 19:36:17 dkf Exp $ */ #include "tclInt.h" @@ -1101,6 +1101,8 @@ Tcl_VwaitObjCmd(clientData, interp, objc, objv) while (!done && foundEvent) { foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS); if (Tcl_LimitExceeded(interp)) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "limit exceeded", NULL); return TCL_ERROR; } } @@ -1190,6 +1192,8 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv) while (Tcl_DoOneEvent(flags) != 0) { if (Tcl_LimitExceeded(interp)) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "limit exceeded", NULL); return TCL_ERROR; } } diff --git a/generic/tclInt.h b/generic/tclInt.h index 38be9d5..5f10b46 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.207 2004/12/14 21:11:46 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.208 2004/12/16 19:36:34 dkf Exp $ */ #ifndef _TCLINT @@ -1408,6 +1408,8 @@ typedef struct Interp { * is reached. */ int timeGranularity; /* Mod factor used to determine how often * to evaluate the limit check. */ + Tcl_TimerToken timeEvent; /* Handle for a timer callback that will + * occur when the time-limit is exceeded. */ Tcl_HashTable callbacks; /* Mapping from (interp,type) pair to data * used to install a limit handler callback @@ -2114,6 +2116,9 @@ MODULE_SCOPE int Tcl_ConcatObjCmd _ANSI_ARGS_((ClientData clientData, MODULE_SCOPE int Tcl_ContinueObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler _ANSI_ARGS_(( + Tcl_Time *timePtr, Tcl_TimerProc *proc, + ClientData clientData)); MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); 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)); diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 8c5a210..12c2ce9 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTimer.c,v 1.12 2004/10/06 15:59:25 dgp Exp $ + * RCS: @(#) $Id: tclTimer.c,v 1.13 2004/12/16 19:36:35 dkf Exp $ */ #include "tclInt.h" @@ -223,30 +223,58 @@ Tcl_CreateTimerHandler(milliseconds, proc, clientData) Tcl_TimerProc *proc; /* Procedure to invoke. */ ClientData clientData; /* Arbitrary data to pass to proc. */ { - register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; Tcl_Time time; - ThreadSpecificData *tsdPtr; - - tsdPtr = InitTimer(); - - timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler)); /* * Compute when the event should fire. */ Tcl_GetTime(&time); - timerHandlerPtr->time.sec = time.sec + milliseconds/1000; - timerHandlerPtr->time.usec = time.usec + (milliseconds%1000)*1000; - if (timerHandlerPtr->time.usec >= 1000000) { - timerHandlerPtr->time.usec -= 1000000; - timerHandlerPtr->time.sec += 1; + time.sec += milliseconds/1000; + time.usec += (milliseconds%1000)*1000; + if (time.usec >= 1000000) { + time.usec -= 1000000; + time.sec += 1; } + return TclCreateAbsoluteTimerHandler(&time, proc, clientData); +} + +/* + *-------------------------------------------------------------- + * + * TclCreateAbsoluteTimerHandler -- + * + * Arrange for a given procedure to be invoked at a particular + * time in the future. + * + * Results: + * The return value is a token for the timer event, which + * may be used to delete the event before it fires. + * + * Side effects: + * When the time in timePtr has been reached, proc will be invoked + * exactly once. + * + *-------------------------------------------------------------- + */ + +Tcl_TimerToken +TclCreateAbsoluteTimerHandler(timePtr, proc, clientData) + Tcl_Time *timePtr; + Tcl_TimerProc *proc; + ClientData clientData; +{ + register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; + ThreadSpecificData *tsdPtr; + + tsdPtr = InitTimer(); + timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler)); /* - * Fill in other fields for the event. + * Fill in fields for the event. */ + memcpy((void *)&timerHandlerPtr->time, (void *)timePtr, sizeof(Tcl_Time)); timerHandlerPtr->proc = proc; timerHandlerPtr->clientData = clientData; tsdPtr->lastTimerId++; @@ -788,7 +816,39 @@ processInteger: ms = 0; } if (objc == 2) { - Tcl_Sleep(ms); + Interp *iPtr = (Interp *) interp; + + if (iPtr->limit.timeEvent != NULL) { + Tcl_Time endTime, now; + + Tcl_GetTime(&endTime); + endTime.sec += ms/1000; + endTime.usec += (ms%1000)*1000; + if (endTime.usec >= 1000000) { + endTime.sec++; + endTime.usec -= 1000000; + } + + do { + Tcl_GetTime(&now); + if (endTime.sec < iPtr->limit.time.sec || + (endTime.sec == iPtr->limit.time.sec && + endTime.usec < iPtr->limit.time.usec)) { + Tcl_Sleep(1000*(endTime.sec - now.sec) + + (endTime.usec - now.usec)/1000); + break; + } else { + Tcl_Sleep(1000*(iPtr->limit.time.sec - now.sec) + + (iPtr->limit.time.usec - now.usec)/1000); + if (Tcl_LimitCheck(interp) != TCL_OK) { + return TCL_ERROR; + } + } + } while (endTime.sec > now.sec || + (endTime.sec == now.sec && endTime.usec > now.usec)); + } else { + Tcl_Sleep(ms); + } return TCL_OK; } afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo))); diff --git a/tests/interp.test b/tests/interp.test index 244a750..9308e90 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -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: interp.test,v 1.43 2004/11/18 21:00:51 dgp Exp $ +# RCS: @(#) $Id: interp.test,v 1.44 2004/12/16 19:36:35 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -3075,7 +3075,28 @@ test interp-34.7 {limits with callbacks: deleting the handler interp} -setup { rename cb3 {} rename cb4 {} } - +# Bug 1085023 +test interp-34.8 {time limits trigger in vwaits} -body { + set i [interp create] + interp limit $i time -seconds [expr {[clock seconds]+1}] -granularity 1 + $i eval { + set x {} + vwait x + } +} -cleanup { + interp delete $i +} -returnCodes error -result {limit exceeded} +test interp-34.9 {time limits trigger in blocking after} { + set i [interp create] + set t0 [clock seconds] + interp limit $i time -seconds [expr {$t0 + 1}] -granularity 1 + set code [catch { + $i eval {after 10000} + } msg] + set t1 [clock seconds] + interp delete $i + list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}] +} {1 {time limit exceeded} OK} test interp-35.1 {interp limit syntax} -body { interp limit } -returnCodes error -result {wrong # args: should be "interp limit path limitType ?options?"} |