diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclTimer.c | 106 | ||||
| -rw-r--r-- | tests/interp.test | 19 |
3 files changed, 96 insertions, 36 deletions
@@ -1,3 +1,10 @@ +2005-06-17 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclTimer.c (AfterDelay): Split out the code to manage + synchronous-delay [after] commands. + * tests/interp.test (interp-34.10): Time limits and synch-delay + [after] did not mix well... [Bug 1221395] + 2005-06-14 Donal K. Fellows <dkf@users.sf.net> * generic/tclBasic.c (Tcl_DeleteCommandFromToken): Only delete a diff --git a/generic/tclTimer.c b/generic/tclTimer.c index a8728f4..85e8c0c 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.15 2005/05/10 18:34:51 kennykb Exp $ + * RCS: @(#) $Id: tclTimer.c,v 1.16 2005/06/17 14:26:15 dkf Exp $ */ #include "tclInt.h" @@ -118,6 +118,7 @@ static Tcl_ThreadDataKey dataKey; static void AfterCleanupProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp)); +static int AfterDelay _ANSI_ARGS_((Tcl_Interp *interp, int ms)); static void AfterProc _ANSI_ARGS_((ClientData clientData)); static void FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr)); static AfterInfo * GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr, @@ -814,40 +815,7 @@ processInteger: ms = 0; } if (objc == 2) { - 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; + return AfterDelay(interp, ms); } afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo))); afterPtr->assocPtr = assocPtr; @@ -992,6 +960,74 @@ processInteger: /* *---------------------------------------------------------------------- * + * AfterDelay -- + * + * Implements the blocking delay behaviour of [after $time]. + * Tricky because it has to take into account any time limit that + * has been set. + * + * Results: + * Standard Tcl result code (with error set if an error occurred + * due to a time limit being exceeded). + * + * Side effects: + * May adjust the time limit granularity marker. + * + *---------------------------------------------------------------------- + */ + +static int +AfterDelay(interp, ms) + Tcl_Interp *interp; + int ms; +{ + Interp *iPtr = (Interp *) interp; +#define TCL_TIME_BEFORE(t1,t2) \ + (((t1).sec<(t2).sec)||((t1).sec==(t2).sec&&(t1).usec<(t2).usec)) +#define TCL_TIME_DIFF_MS(t1,t2) \ + (1000*((long)(t1).sec - (long)(t2).sec) + \ + ((long)(t1).usec - (long)(t2).usec)/1000) + + 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 (TCL_TIME_BEFORE(iPtr->limit.time, now)) { + iPtr->limit.granularityTicker = 0; + if (Tcl_LimitCheck(interp) != TCL_OK) { + return TCL_ERROR; + } + } + if (TCL_TIME_BEFORE(endTime, iPtr->limit.time)) { + Tcl_Sleep(TCL_TIME_DIFF_MS(endTime, now)); + break; + } else { + Tcl_Sleep(TCL_TIME_DIFF_MS(iPtr->limit.time, now)); + if (Tcl_LimitCheck(interp) != TCL_OK) { + return TCL_ERROR; + } + } + } while (TCL_TIME_BEFORE(now, endTime)); + } else { + Tcl_Sleep(ms); + } +#undef TCL_TIME_BEFORE +#undef TCL_TIME_DIFF_MS + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * GetAfterEvent -- * * This procedure parses an "after" id such as "after#4" and diff --git a/tests/interp.test b/tests/interp.test index c5568b6..f801247 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.45 2005/05/10 18:35:20 kennykb Exp $ +# RCS: @(#) $Id: interp.test,v 1.46 2005/06/17 14:26:15 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -3097,6 +3097,23 @@ test interp-34.9 {time limits trigger in blocking after} { interp delete $i list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}] } {1 {time limit exceeded} OK} +test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body { + set i [interp create] + # Assume someone hasn't set the clock to early 1970! + $i limit time -seconds 1 -granularity 4 + interp alias $i log {} lappend result + set result {} + catch { + $i eval { + log 1 + after 100 + log 2 + } + } msg + interp delete $i + lappend result $msg +} -result {1 {time limit exceeded}} + test interp-35.1 {interp limit syntax} -body { interp limit } -returnCodes error -result {wrong # args: should be "interp limit path limitType ?options?"} |