From c58a554a8152ee69ceb992395233d72e0a9980ae Mon Sep 17 00:00:00 2001 From: Kevin B Kenny Date: Wed, 9 Nov 2005 21:28:36 +0000 Subject: bugs 1350291 and 1350293 --- ChangeLog | 7 +++ generic/tclTimer.c | 136 +++++++++++++++++++++++++++++++---------------------- tests/timer.test | 34 ++++++++++++-- 3 files changed, 117 insertions(+), 60 deletions(-) diff --git a/ChangeLog b/ChangeLog index bf99435..371d2a2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2005-11-09 Kevin B. Kenny + + * generic/tclTimer.c: Changed [after] so that it behaves correctly + * tests/timer.test: with negative arguments [Bug 1350293] and + arguments that overflow a 32-bit word + [Bug 1350291]. + 2005-11-08 Don Porter * tests/compile.test: Updated tests with changed behavior diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 5f0b758..6c07717 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.20 2005/10/31 15:59:41 dkf Exp $ + * RCS: @(#) $Id: tclTimer.c,v 1.21 2005/11/09 21:28:36 kennykb Exp $ */ #include "tclInt.h" @@ -126,7 +126,7 @@ static Tcl_ThreadDataKey dataKey; (((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) + \ + (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \ ((long)(t1).usec - (long)(t2).usec)/1000) /* @@ -135,7 +135,7 @@ static Tcl_ThreadDataKey dataKey; static void AfterCleanupProc(ClientData clientData, Tcl_Interp *interp); -static int AfterDelay(Tcl_Interp *interp, int ms); +static int AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms); static void AfterProc(ClientData clientData); static void FreeAfterPtr(AfterInfo *afterPtr); static AfterInfo * GetAfterEvent(AfterAssocData *assocPtr, @@ -771,11 +771,11 @@ Tcl_AfterObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { - int ms; + Tcl_WideInt ms; /* Number of milliseconds to wait */ + Tcl_Time wakeup; AfterInfo *afterPtr; AfterAssocData *assocPtr; int length; - char *argString; int index; char buf[16 + TCL_INTEGER_SPACE]; static CONST char *afterSubCmds[] = { @@ -808,16 +808,30 @@ Tcl_AfterObjCmd( * First lets see if the command was passed a number as the first argument. */ - if (objv[1]->typePtr == &tclIntType) { - ms = (int) objv[1]->internalRep.longValue; - goto processInteger; - } - argString = Tcl_GetStringFromObj(objv[1], &length); - if (isdigit(UCHAR(argString[0]))) { /* INTL: digit */ - if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) { + if (objv[1]->typePtr == &tclIntType +#ifndef NO_WIDE_TYPE + || objv[1]->typePtr == &tclWideIntType +#endif + || objv[1]->typePtr == &tclBignumType + || ( Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, + &index) != TCL_OK )) { + index = -1; + if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { + Tcl_AppendResult(interp, "bad argument \"", + Tcl_GetString(objv[1]), + "\": must be cancel, idle, info, or an integer", + NULL); return TCL_ERROR; } - processInteger: + } + + /* + * At this point, either index = -1 and ms contains the number of ms + * to wait, or else index is the index of a subcommand. + */ + + switch ((enum afterSubCmds) index) { + case -1: { if (ms < 0) { ms = 0; } @@ -845,8 +859,15 @@ Tcl_AfterObjCmd( afterPtr->id = tsdPtr->afterId; tsdPtr->afterId += 1; - afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc, - (ClientData) afterPtr); + Tcl_GetTime(&wakeup); + wakeup.sec += (time_t)(ms / 1000); + wakeup.usec += ((int)(ms % 1000)) * 1000; + if (wakeup.usec > 1000000) { + wakeup.sec++; + wakeup.usec -= 1000000; + } + afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup, AfterProc, + (ClientData) afterPtr); afterPtr->nextPtr = assocPtr->firstAfterPtr; assocPtr->firstAfterPtr = afterPtr; objPtr = Tcl_NewObj(); @@ -854,19 +875,6 @@ Tcl_AfterObjCmd( Tcl_SetObjResult(interp, objPtr); return TCL_OK; } - - /* - * If it's not a number it must be a subcommand. Note that we're using a - * custom error message here, so we do not pass an interpreter to T_GIFO. - */ - - if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "argument", 0, - &index) != TCL_OK) { - Tcl_AppendResult(interp, "bad argument \"", argString, - "\": must be cancel, idle, info, or a number", NULL); - return TCL_ERROR; - } - switch ((enum afterSubCmds) index) { case AFTER_CANCEL: { Tcl_Obj *commandPtr; char *command, *tempCommand; @@ -988,42 +996,56 @@ Tcl_AfterObjCmd( static int AfterDelay( Tcl_Interp *interp, - int ms) + Tcl_WideInt ms) { Interp *iPtr = (Interp *) interp; - if (iPtr->limit.timeEvent != NULL) { - Tcl_Time endTime, now; + Tcl_Time endTime, now; + Tcl_WideInt diff; - Tcl_GetTime(&endTime); - endTime.sec += ms/1000; - endTime.usec += (ms%1000)*1000; - if (endTime.usec >= 1000000) { - endTime.sec++; - endTime.usec -= 1000000; - } + Tcl_GetTime(&endTime); + endTime.sec += (time_t)(ms/1000); + endTime.usec += ((int)(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; - } + do { + Tcl_GetTime(&now); + if (iPtr->limit.timeEvent != NULL + && 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; - } + } + if (iPtr->limit.timeEvent == NULL + || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) { + diff = TCL_TIME_DIFF_MS(endTime, now); +#ifndef TCL_WIDE_INT_IS_LONG + if (diff > LONG_MAX) { + diff = LONG_MAX; } - } while (TCL_TIME_BEFORE(now, endTime)); - } else { - Tcl_Sleep(ms); - } +#endif + if (diff > 0) { + Tcl_Sleep((long)diff); + } + } else { + diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now); +#ifndef TCL_WIDE_INT_IS_LONG + if (diff > LONG_MAX) { + diff = LONG_MAX; + } +#endif + if (diff > 0) { + Tcl_Sleep((long)diff); + } + if (Tcl_LimitCheck(interp) != TCL_OK) { + return TCL_ERROR; + } + } + } while (TCL_TIME_BEFORE(now, endTime)); return TCL_OK; } diff --git a/tests/timer.test b/tests/timer.test index 800857b..6eecb7c 100644 --- a/tests/timer.test +++ b/tests/timer.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: timer.test,v 1.11 2004/11/18 19:22:14 dgp Exp $ +# RCS: @(#) $Id: timer.test,v 1.12 2005/11/09 21:28:36 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -177,10 +177,10 @@ test timer-6.1 {Tcl_AfterCmd procedure, basics} { } {1 {wrong # args: should be "after option ?arg arg ...?"}} test timer-6.2 {Tcl_AfterCmd procedure, basics} { list [catch {after 2x} msg] $msg -} {1 {expected integer but got "2x"}} +} {1 {bad argument "2x": must be cancel, idle, info, or an integer}} test timer-6.3 {Tcl_AfterCmd procedure, basics} { list [catch {after gorp} msg] $msg -} {1 {bad argument "gorp": must be cancel, idle, info, or a number}} +} {1 {bad argument "gorp": must be cancel, idle, info, or an integer}} test timer-6.4 {Tcl_AfterCmd procedure, ms argument} { set x before after 400 {set x after} @@ -552,6 +552,34 @@ test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup { interp delete slave } -result ::after +test timer-11.1 {Bug 1350291: [after] overflowing 32-bit field} \ + -body { + set b ok + set a [after 0x100000001 {set b "after fired early"}] + after 100 set done 1 + vwait done + set b + } \ + -cleanup { + catch {after cancel $a} + } \ + -result ok + +test timer-11.2 {Bug 1350293: [after] negative argument} \ + -body { + set l {} + after 100 {lappend l 100; set done 1} + after -1 {lappend l -1} + vwait done + set l + } \ + -result {-1 100} + + # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: -- cgit v0.12