Tests of limit-exceeded callbacks and make sure that those callbacks can remove

the limits if they see fit (as well as extending them).

3 files changed, 63 insertions, 4 deletions

diff --git a/ChangeLog b/ChangeLog
index 21c6f56..e214ef4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2004-05-18  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
+
+	* generic/tclInterp.c (Tcl_LimitCheck, Tcl_LimitTypeReset): Reset
+	the limit-exceeded flag when removing a limit.
+
 2004-05-18  Miguel Sofer <msofer@users.sf.net>
 
 	* generic/tclExecute.c (TclExecuteByteCode): added comments to
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 616c244..01a73d1 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -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: tclInterp.c,v 1.28 2004/05/13 20:31:08 dkf Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.29 2004/05/18 09:29:30 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2634,12 +2634,13 @@ Tcl_LimitCheck(interp)
 	RunLimitHandlers(iPtr->limit.cmdHandlers, interp);
 	if (iPtr->limit.cmdCount >= iPtr->cmdCount) {
 	    iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
-	} else {
+	} else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) {
 	    Tcl_ResetResult(interp);
 	    Tcl_AppendResult(interp, "command count limit exceeded", NULL);
 	    Tcl_Release(interp);
 	    return TCL_ERROR;
 	}
+	Tcl_Release(interp);
     }
 
     if ((iPtr->limit.active & TCL_LIMIT_TIME) &&
@@ -2658,12 +2659,13 @@ Tcl_LimitCheck(interp)
 		    (iPtr->limit.time.sec == now.sec &&
 		    iPtr->limit.time.usec < now.usec)) {
 		iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
-	    } else {
+	    } else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) {
 		Tcl_ResetResult(interp);
 		Tcl_AppendResult(interp, "time limit exceeded", NULL);
 		Tcl_Release(interp);
 		return TCL_ERROR;
 	    }
+	    Tcl_Release(interp);
 	}
     }
 
@@ -2884,6 +2886,7 @@ Tcl_LimitTypeReset(interp, type)
     Interp *iPtr = (Interp *) interp;
 
     iPtr->limit.active &= ~type;
+    iPtr->limit.exceeded &= ~type;
 }
 
 void
diff --git a/tests/interp.test b/tests/interp.test
index 29af84c..ace4ad7 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.30 2004/05/17 21:30:13 dkf Exp $
+# RCS: @(#) $Id: interp.test,v 1.31 2004/05/18 09:29:30 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -2915,6 +2915,57 @@ test interp-34.3 {basic test of limits - pure bytecode loop} knownBug {
     interp delete $i
     set msg
 } {1 {command count limit exceeded}}
+test interp-34.4 {limits with callbacks: extending limits} -setup {
+    set i [interp create]
+    set a 0
+    set b 0
+    set c a
+    proc cb1 {} {
+	global c
+	incr ::$c
+    }
+    proc cb2 {newlimit args} {
+	global c i
+	set c b
+	$i limit command -value $newlimit
+    }
+} -body {
+    interp alias $i foo {} cb1
+    set curlim [$i eval info cmdcount]
+    $i limit command -command "cb2 [expr $curlim+100]" \
+	    -value [expr {$curlim+10}]
+    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
+    list $a $b $c
+} -result {6 4 b} -cleanup {
+    interp delete $i
+    rename cb1 {}
+    rename cb2 {}
+}
+test interp-34.5 {limits with callbacks: removing limits} -setup {
+    set i [interp create]
+    set a 0
+    set b 0
+    set c a
+    proc cb1 {} {
+	global c
+	incr ::$c
+    }
+    proc cb2 {newlimit args} {
+	global c i
+	set c b
+	$i limit command -value $newlimit
+    }
+} -body {
+    interp alias $i foo {} cb1
+    set curlim [$i eval info cmdcount]
+    $i limit command -command "cb2 {}" -value [expr {$curlim+10}]
+    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
+    list $a $b $c
+} -result {6 4 b} -cleanup {
+    interp delete $i
+    rename cb1 {}
+    rename cb2 {}
+}
 
 test interp-35.1 {interp limit syntax} -body {
     interp limit