Improved TIP#143 tests and now track the number of bytecoded commands better.

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] {