diff options
| -rw-r--r-- | tests/timer.test | 49 |
1 files changed, 34 insertions, 15 deletions
diff --git a/tests/timer.test b/tests/timer.test index 2f75d28..25aff8d 100644 --- a/tests/timer.test +++ b/tests/timer.test @@ -18,7 +18,26 @@ source [file dirname [info script]]/testing.tcl needs cmd after eventloop -test timer-1.1 {Tcl_CreateTimerHandler procedure} { +# Before we start, some of these timer tests can be fragile if running on +# a VM or overloaded system where wall time and cpu are not +# in sync. Run a quick test to see if this seems to be the case +# and if so skip these tests. + +set goodtime 1 +set prev [clock micros] +for {set i 0} {$i < 10} {incr i} { + after 10 + set now [clock micros] + if {$now - $prev > 15000} { + # a 10ms wait took more than 15ms + set goodtime 0 + break + } + set prev $now +} +constraint expr goodtime $goodtime + +test timer-1.1 {Tcl_CreateTimerHandler procedure} goodtime { foreach i [after info] { after cancel $i } @@ -31,7 +50,7 @@ test timer-1.1 {Tcl_CreateTimerHandler procedure} { set x } {20 40 60 80} -test timer-2.1 {Tcl_DeleteTimerHandler procedure} { +test timer-2.1 {Tcl_DeleteTimerHandler procedure} goodtime { foreach i [after info] { after cancel $i } @@ -49,7 +68,7 @@ test timer-2.1 {Tcl_DeleteTimerHandler procedure} { # No tests for Tcl_ServiceTimer or ResetTimer, since it is already tested # above. -test timer-3.1 {TimerHandlerEventProc procedure: event masks} { +test timer-3.1 {TimerHandlerEventProc procedure: event masks} goodtime { set x start after 20 { set x fired } update idletasks @@ -58,7 +77,7 @@ test timer-3.1 {TimerHandlerEventProc procedure: event masks} { update lappend result $x } {start fired} -test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} { +test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} goodtime { foreach i [after info] { after cancel $i } @@ -77,7 +96,7 @@ test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} { update lappend result $x } {80 {80 240} {80 240 400}} -test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} { +test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} goodtime { foreach i [after info] { after cancel $i } @@ -89,7 +108,7 @@ test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} { update set x } 20 -test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} { +test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} goodtime { foreach i [after info] { after cancel $i } @@ -101,7 +120,7 @@ test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} { vwait x set x } {a b c} -test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} { +test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} goodtime { foreach i [after info] { after cancel $i } @@ -111,7 +130,7 @@ test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't vwait x set x } a -test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} { +test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} goodtime { foreach i [after info] { after cancel $i } @@ -127,7 +146,7 @@ test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't # No tests for Tcl_DoWhenIdle: it's already tested by other tests # below. -test timer-4.1 {Tcl_CancelIdleCall procedure} { +test timer-4.1 {Tcl_CancelIdleCall procedure} goodtime { foreach i [after info] { after cancel $i } @@ -156,7 +175,7 @@ test timer-4.2 {Tcl_CancelIdleCall procedure} { concat $x $y $z } {before after2 after3} -test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} { +test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} goodtime { foreach i [after info] { after cancel $i } @@ -179,7 +198,7 @@ test timer-6.2 {Tcl_AfterCmd procedure, basics} jim { test timer-6.3 {Tcl_AfterCmd procedure, basics} jim { list [catch {after gorp} msg] $msg } {1 {bad argument "gorp": must be cancel, idle, or info}} -test timer-6.4 {Tcl_AfterCmd procedure, ms argument} { +test timer-6.4 {Tcl_AfterCmd procedure, ms argument} goodtime { set x before after 500 {set x after} after 100 @@ -199,7 +218,7 @@ test timer-6.7 {Tcl_AfterCmd procedure, cancel option} { test timer-6.8 {Tcl_AfterCmd procedure, cancel option} { after cancel {foo bar} } {} -test timer-6.9 {Tcl_AfterCmd procedure, cancel option} { +test timer-6.9 {Tcl_AfterCmd procedure, cancel option} goodtime { foreach i [after info] { after cancel $i } @@ -210,7 +229,7 @@ test timer-6.9 {Tcl_AfterCmd procedure, cancel option} { update set x } {before} -test timer-6.10 {Tcl_AfterCmd procedure, cancel option} { +test timer-6.10 {Tcl_AfterCmd procedure, cancel option} goodtime { foreach i [after info] { after cancel $i } @@ -221,7 +240,7 @@ test timer-6.10 {Tcl_AfterCmd procedure, cancel option} { update set x } {before} -test timer-6.11 {Tcl_AfterCmd procedure, cancel option} { +test timer-6.11 {Tcl_AfterCmd procedure, cancel option} goodtime { foreach i [after info] { after cancel $i } @@ -263,7 +282,7 @@ test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for c update idletasks set x } {first third} -test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} { +test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} goodtime { foreach i [after info] { after cancel $i } |