summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclExecute.c5
-rw-r--r--tests/interp.test28
3 files changed, 24 insertions, 13 deletions
diff --git a/ChangeLog b/ChangeLog
index 8884b16..e087710 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
2004-05-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclExecute.c (TEBC:INST_START_CMD): Make sure that the
+ command-count is always advanced. Allows TIP#143 limits to tell
+ that work is being done.
+
* doc/list.n: Updated example to fit with the unified format.
* doc/seek.n: Added some examples.
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c61f3f1..7d141bd 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.133 2004/05/17 02:36:46 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.134 2004/05/17 21:30:12 dkf Exp $
*/
#include "tclInt.h"
@@ -1343,7 +1343,8 @@ TclExecuteByteCode(interp, codePtr)
* its compileEpoch is modified, so that the epoch
* check also verifies that the interp is not deleted.
*/
-
+
+ iPtr->cmdCount++;
if (((codeCompileEpoch == iPtr->compileEpoch)
&& (codeNsEpoch == namespacePtr->resolverEpoch))
|| codePrecompiled) {
diff --git a/tests/interp.test b/tests/interp.test
index 78ad9c9..29af84c 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.29 2004/05/14 15:38:56 dkf Exp $
+# RCS: @(#) $Id: interp.test,v 1.30 2004/05/17 21:30:13 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -2842,8 +2842,7 @@ test interp-31.1 {alias invocation scope} {
set result
} ok
-test interp-32.1 { parent's working directory should
- be inherited by a child interp } {
+test interp-32.1 {parent's working directory should be inherited by a child interp} {
cd [temporaryDirectory]
set parent [pwd]
set i [interp create]
@@ -2872,7 +2871,7 @@ test interp-33.1 {refCounting for target words of alias [Bug 730244]} {
$i eval alias
} this
-test interp-34.1 {basic test of limits - calling commands} {
+test interp-34.1 {basic test of limits - calling commands} -body {
set i [interp create]
$i eval {
proc foobar {} {
@@ -2883,11 +2882,11 @@ test interp-34.1 {basic test of limits - calling commands} {
}
}
$i limit command -value 1000
- set msg [list [catch {$i eval foobar} msg] $msg]
+ $i eval foobar
+} -returnCodes error -result {command count limit exceeded} -cleanup {
interp delete $i
- set msg
-} {1 {command count limit exceeded}}
-test interp-34.2 {basic test of limits - bytecoded commands} knownBug {
+}
+test interp-34.2 {basic test of limits - bytecoded commands} -body {
set i [interp create]
$i eval {
proc foobar {} {
@@ -2898,10 +2897,10 @@ test interp-34.2 {basic test of limits - bytecoded commands} knownBug {
}
}
$i limit command -value 1000
- set msg [list [catch {$i eval foobar} msg] $msg]
+ $i eval foobar
+} -returnCodes error -result {command count limit exceeded} -cleanup {
interp delete $i
- set msg
-} {1 {command count limit exceeded}}
+}
test interp-34.3 {basic test of limits - pure bytecode loop} knownBug {
set i [interp create]
$i eval {
@@ -3044,6 +3043,13 @@ test interp-35.21 {interp limit syntax} -body {
} -cleanup {
interp delete $i
} -returnCodes error -result {milliseconds must be at least 0}
+test interp-35.22 {interp time limits normalize milliseconds} -body {
+ set i [interp create]
+ interp limit $i time -seconds 1 -millis 1500
+ list [$i limit time -seconds] [$i limit time -millis]
+} -cleanup {
+ interp delete $i
+} -result {2 500}
# cleanup
foreach i [interp slaves] {