Fix an odd [after]-and-limits problem. [Bug 1221395]

3 files changed, 96 insertions, 36 deletions

diff --git a/ChangeLog b/ChangeLog
index 36b7688..0de5f2b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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?"}