summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-10-10 17:33:25 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-10-10 17:33:25 (GMT)
commit74451872e37a31feb47b7be05b8175603f0526ce (patch)
treee7cc109788ffe0692afffb847928fa9eba126fc6 /tests
parentdb048c3be987aa1a9a98a71fc6e164ca746b9333 (diff)
downloadtcl-74451872e37a31feb47b7be05b8175603f0526ce.zip
tcl-74451872e37a31feb47b7be05b8175603f0526ce.tar.gz
tcl-74451872e37a31feb47b7be05b8175603f0526ce.tar.bz2
Fix two bugs in limits, one a crash and the other a failed flag reset.
Diffstat (limited to 'tests')
-rw-r--r--tests/interp.test64
1 files changed, 60 insertions, 4 deletions
diff --git a/tests/interp.test b/tests/interp.test
index f801247..d2acbdd 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.46 2005/06/17 14:26:15 dkf Exp $
+# RCS: @(#) $Id: interp.test,v 1.47 2005/10/10 17:33:26 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -25,8 +25,6 @@ foreach i [interp slaves] {
interp delete $i
}
-proc equiv {x} {return $x}
-
# Part 0: Check out options for interp command
test interp-1.1 {options for interp command} {
list [catch {interp} msg] $msg
@@ -379,7 +377,7 @@ test interp-10.7 {testing aliases between interpreters} {
set x [foo 33]
a eval {rename zoppo {}}
interp alias "" foo a {}
- equiv $x
+ return $x
} {33 33 33}
# Part 10: Testing "interp target"
@@ -3113,6 +3111,64 @@ test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body {
interp delete $i
lappend result $msg
} -result {1 {time limit exceeded}}
+test interp-34.11 {time limit extension in callbacks} -setup {
+ proc cb1 {i t} {
+ global result
+ lappend result cb1
+ $i limit time -seconds $t -command cb2
+ }
+ proc cb2 {} {
+ global result
+ lappend result cb2
+ }
+} -body {
+ set i [interp create]
+ set t0 [clock seconds]
+ $i limit time -seconds [expr {$t0+1}] -granularity 1 \
+ -command "cb1 $i [expr {$t0+2}]"
+ set ::result {}
+ lappend ::result [catch {
+ $i eval {
+ for {set i 0} {$i<30} {incr i} {
+ after 100
+ }
+ }
+ } msg] $msg
+ set t1 [clock seconds]
+ lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}]
+ interp delete $i
+ return $::result
+} -result {cb1 cb2 1 {time limit exceeded} ok} -cleanup {
+ rename cb1 {}
+ rename cb2 {}
+}
+test interp-34.12 {time limit extension in callbacks} -setup {
+ proc cb1 {i} {
+ global result times
+ lappend result cb1
+ set times [lassign $times t]
+ $i limit time -seconds $t
+ }
+} -body {
+ set i [interp create]
+ set t0 [clock seconds]
+ set ::times "[expr {$t0+2}] [expr {$t0+100}]"
+ $i limit time -seconds [expr {$t0+1}] -granularity 1 -command "cb1 $i"
+ set ::result {}
+ lappend ::result [catch {
+ $i eval {
+ for {set i 0} {$i<30} {incr i} {
+ after 100
+ }
+ }
+ } msg] $msg
+ set t1 [clock seconds]
+ lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}]
+ interp delete $i
+ return $::result
+} -result {cb1 cb1 0 {} ok} -cleanup {
+ rename cb1 {}
+}
test interp-35.1 {interp limit syntax} -body {
interp limit