summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-06-17 14:26:12 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-06-17 14:26:12 (GMT)
commite1e80d15370c158d3ae2870cfc5d26e1d9791046 (patch)
tree95df7d34659bebf57faac87ff7db23f96cdc014d
parent9480f190e5c0b49511894e60db3c34b9a7a81003 (diff)
downloadtcl-e1e80d15370c158d3ae2870cfc5d26e1d9791046.zip
tcl-e1e80d15370c158d3ae2870cfc5d26e1d9791046.tar.gz
tcl-e1e80d15370c158d3ae2870cfc5d26e1d9791046.tar.bz2
Fix an odd [after]-and-limits problem. [Bug 1221395]
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclTimer.c106
-rw-r--r--tests/interp.test19
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?"}