summaryrefslogtreecommitdiffstats
path: root/tests/timer.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/timer.test')
-rw-r--r--tests/timer.test53
1 files changed, 37 insertions, 16 deletions
diff --git a/tests/timer.test b/tests/timer.test
index 3dd140e..db508e5 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -14,7 +14,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+ package require tcltest
namespace import -force ::tcltest::*
}
@@ -26,8 +26,8 @@ test timer-1.1 {Tcl_CreateTimerHandler procedure} {
foreach i {100 200 1000 50 150} {
after $i lappend x $i
}
- after 200
- update
+ after 200 set done 1
+ vwait done
set x
} {50 100 150 200}
@@ -36,13 +36,13 @@ test timer-2.1 {Tcl_DeleteTimerHandler procedure} {
after cancel $i
}
set x ""
- foreach i {100 200 300 50 150} {
+ foreach i {100 200 1000 50 150} {
after $i lappend x $i
}
after cancel lappend x 150
after cancel lappend x 50
- after 200
- update
+ after 200 set done 1
+ vwait done
set x
} {100 200}
@@ -175,10 +175,10 @@ test timer-6.1 {Tcl_AfterCmd procedure, basics} {
} {1 {wrong # args: should be "after option ?arg arg ...?"}}
test timer-6.2 {Tcl_AfterCmd procedure, basics} {
list [catch {after 2x} msg] $msg
-} {1 {expected integer but got "2x"}}
+} {1 {bad argument "2x": must be cancel, idle, info, or an integer}}
test timer-6.3 {Tcl_AfterCmd procedure, basics} {
list [catch {after gorp} msg] $msg
-} {1 {bad argument "gorp": must be cancel, idle, info, or a number}}
+} {1 {bad argument "gorp": must be cancel, idle, info, or an integer}}
test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {
set x before
after 400 {set x after}
@@ -453,20 +453,22 @@ test timer-8.1 {AfterProc procedure} {
}
list [foo] $x
} {untouched after}
-test timer-8.2 {AfterProc procedure} {
- catch {rename bgerror {}}
- proc bgerror msg {
- global x errorInfo
- set x [list $msg $errorInfo]
+test timer-8.2 {AfterProc procedure} -setup {
+ variable x empty
+ proc myHandler {msg options} {
+ variable x [list $msg [dict get $options -errorinfo]]
}
- set x empty
+ set handler [interp bgerror {}]
+ interp bgerror {} [namespace which myHandler]
+} -body {
after 100 {error "After error"}
after 200
set y $x
update
- catch {rename bgerror {}}
list $y $x
-} {empty {{After error} {After error
+} -cleanup {
+ interp bgerror {} $handler
+} -result {empty {{After error} {After error
while executing
"error "After error""
("after" script)}}}
@@ -535,6 +537,7 @@ test timer-9.1 {AfterCleanupProc procedure} {
update
set x
} {before after2 after4}
+
test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup {
interp create slave
slave eval namespace export after
@@ -547,6 +550,19 @@ test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup {
interp delete slave
} -result ::after
+test timer-11.1 {Bug 1350291: [after] overflowing 32-bit field} \
+ -body {
+ set b ok
+ set a [after 0x100000001 {set b "after fired early"}]
+ after 100 set done 1
+ vwait done
+ set b
+ } \
+ -cleanup {
+ catch {after cancel $a}
+ } \
+ -result ok
+
test timer-11.2 {Bug 1350293: [after] negative argument} \
-body {
set l {}
@@ -557,6 +573,11 @@ test timer-11.2 {Bug 1350293: [after] negative argument} \
} \
-result {-1 100}
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: