summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclTimer.c136
-rw-r--r--tests/timer.test34
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 <kennykb@acm.org>
+
+ * 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 <dgp@users.sourceforge.net>
* 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:
generated by cgit v0.12 at 2024-11-23 00:30:47 (GMT)