diff options
Diffstat (limited to 'tests/timer.test')
-rw-r--r-- | tests/timer.test | 53 |
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: |