bugs 1350291 and 1350293

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: