diff options
Diffstat (limited to 'tests/timer.test')
| -rw-r--r-- | tests/timer.test | 455 |
1 files changed, 455 insertions, 0 deletions
diff --git a/tests/timer.test b/tests/timer.test new file mode 100644 index 0000000..4671366 --- /dev/null +++ b/tests/timer.test @@ -0,0 +1,455 @@ +# This file contains a collection of tests for the procedures in the +# file tclTimer.c, which includes the "after" Tcl command. Sourcing +# this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1997 by Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: @(#) timer.test 1.2 97/04/29 11:59:59 + +if {[string compare test [info procs test]] == 1} then {source defs} + +test timer-1.1 {Tcl_CreateTimerHandler procedure} { + foreach i [after info] { + after cancel $i + } + set x "" + foreach i {100 200 1000 50 150} { + after $i lappend x $i + } + after 200 + update + set x +} {50 100 150 200} + +test timer-2.1 {Tcl_DeleteTimerHandler procedure} { + foreach i [after info] { + after cancel $i + } + set x "" + foreach i {100 200 300 50 150} { + after $i lappend x $i + } + after cancel lappend x 150 + after cancel lappend x 50 + after 200 + update + set x +} {100 200} + +# No tests for Tcl_ServiceTimer or ResetTimer, since it is already tested +# above. + +test timer-3.1 {TimerHandlerEventProc procedure: event masks} { + set x start + after 100 { set x fired } + update idletasks + set result $x + after 200 + update + lappend result $x +} {start fired} +test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} { + foreach i [after info] { + after cancel $i + } + foreach i {200 600 1000} { + after $i lappend x $i + } + after 200 + set result "" + set x "" + update + lappend result $x + after 400 + update + lappend result $x + after 400 + update + lappend result $x +} {200 {200 600} {200 600 1000}} +test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} { + foreach i [after info] { + after cancel $i + } + set x {} + after 100 lappend x 100 + set i [after 300 lappend x 300] + after 200 after cancel $i + after 400 + update + set x +} 100 +test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} { + foreach i [after info] { + after cancel $i + } + set x {} + after 100 lappend x a + after 200 lappend x b + after 300 lappend x c + after 300 + vwait x + set x +} {a b c} +test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} { + foreach i [after info] { + after cancel $i + } + set x {} + after 100 {lappend x a; after 0 lappend x b} + after 100 + vwait x + set x +} a +test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} { + foreach i [after info] { + after cancel $i + } + set x {} + after 100 {lappend x a; after 100 lappend x b; after 100} + after 100 + vwait x + set result $x + vwait x + lappend result $x +} {a {a b}} + +# No tests for Tcl_DoWhenIdle: it's already tested by other tests +# below. + +test timer-4.1 {Tcl_CancelIdleCall procedure} { + foreach i [after info] { + after cancel $i + } + set x before + set y before + set z before + after idle set x after1 + after idle set y after2 + after idle set z after3 + after cancel set y after2 + update idletasks + concat $x $y $z +} {after1 before after3} +test timer-4.2 {Tcl_CancelIdleCall procedure} { + foreach i [after info] { + after cancel $i + } + set x before + set y before + set z before + after idle set x after1 + after idle set y after2 + after idle set z after3 + after cancel set x after1 + update idletasks + concat $x $y $z +} {before after2 after3} + +test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} { + foreach i [after info] { + after cancel $i + } + set x 1 + set y 23 + after idle {incr x; after idle {incr x; after idle {incr x}}} + after idle {incr y} + vwait x + set result "$x $y" + update idletasks + lappend result $x +} {2 24 4} + +test timer-6.1 {Tcl_AfterCmd procedure, basics} { + list [catch {after} msg] $msg +} {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"}} +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}} +test timer-6.4 {Tcl_AfterCmd procedure, ms argument} { + set x before + after 400 {set x after} + after 200 + update + set y $x + after 400 + update + list $y $x +} {before after} +test timer-6.5 {Tcl_AfterCmd procedure, ms argument} { + set x before + after 300 set x after + after 200 + update + set y $x + after 200 + update + list $y $x +} {before after} +test timer-6.6 {Tcl_AfterCmd procedure, cancel option} { + list [catch {after cancel} msg] $msg +} {1 {wrong # args: should be "after cancel id|command"}} +test timer-6.7 {Tcl_AfterCmd procedure, cancel option} { + after cancel after#1 +} {} +test timer-6.8 {Tcl_AfterCmd procedure, cancel option} { + after cancel {foo bar} +} {} +test timer-6.9 {Tcl_AfterCmd procedure, cancel option} { + foreach i [after info] { + after cancel $i + } + set x before + set y [after 100 set x after] + after cancel $y + after 200 + update + set x +} {before} +test timer-6.10 {Tcl_AfterCmd procedure, cancel option} { + foreach i [after info] { + after cancel $i + } + set x before + after 100 set x after + after cancel {set x after} + after 200 + update + set x +} {before} +test timer-6.11 {Tcl_AfterCmd procedure, cancel option} { + foreach i [after info] { + after cancel $i + } + set x before + after 100 set x after + set id [after 300 set x after] + after cancel $id + after 200 + update + set y $x + set x cleared + after 200 + update + list $y $x +} {after cleared} +test timer-6.12 {Tcl_AfterCmd procedure, cancel option} { + foreach i [after info] { + after cancel $i + } + set x first + after idle lappend x second + after idle lappend x third + set i [after idle lappend x fourth] + after cancel {lappend x second} + after cancel $i + update idletasks + set x +} {first third} +test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} { + foreach i [after info] { + after cancel $i + } + set x first + after idle lappend x second + after idle lappend x third + set i [after idle lappend x fourth] + after cancel lappend x second + after cancel $i + update idletasks + set x +} {first third} +test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} { + foreach i [after info] { + after cancel $i + } + set id [ + after 100 { + set x done + after cancel $id + } + ] + vwait x +} {} +test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} { + foreach i [after info] { + after cancel $i + } + interp create x + x eval {set a before; set b before; after idle {set a a-after}; + after idle {set b b-after}} + set result [llength [x eval after info]] + lappend result [llength [after info]] + after cancel {set b b-after} + set a aaa + set b bbb + x eval {after cancel set a a-after} + update idletasks + lappend result $a $b [x eval {list $a $b}] + interp delete x + set result +} {2 0 aaa bbb {before b-after}} +test timer-6.16 {Tcl_AfterCmd procedure, idle option} { + list [catch {after idle} msg] $msg +} {1 {wrong # args: should be "after idle script script ..."}} +test timer-6.17 {Tcl_AfterCmd procedure, idle option} { + set x before + after idle {set x after} + set y $x + update idletasks + list $y $x +} {before after} +test timer-6.18 {Tcl_AfterCmd procedure, idle option} { + set x before + after idle set x after + set y $x + update idletasks + list $y $x +} {before after} +set event1 [after idle event 1] +set event2 [after 1000 event 2] +interp create x +set childEvent [x eval {after idle event in child}] +test timer-6.19 {Tcl_AfterCmd, info option} { + lsort [after info] +} [lsort "$event1 $event2"] +test timer-6.20 {Tcl_AfterCmd, info option} { + list [catch {after info a b} msg] $msg +} {1 {wrong # args: should be "after info ?id?"}} +test timer-6.21 {Tcl_AfterCmd, info option} { + list [catch {after info $childEvent} msg] $msg +} "1 {event \"$childEvent\" doesn't exist}" +test timer-6.22 {Tcl_AfterCmd, info option} { + list [after info $event1] [after info $event2] +} {{{event 1} idle} {{event 2} timer}} +after cancel $event1 +after cancel $event2 +interp delete x + +set event [after idle foo bar] +scan $event after#%d id +test timer-7.1 {GetAfterEvent procedure} { + list [catch {after info xfter#$id} msg] $msg +} "1 {event \"xfter#$id\" doesn't exist}" +test timer-7.2 {GetAfterEvent procedure} { + list [catch {after info afterx$id} msg] $msg +} "1 {event \"afterx$id\" doesn't exist}" +test timer-7.3 {GetAfterEvent procedure} { + list [catch {after info after#ab} msg] $msg +} {1 {event "after#ab" doesn't exist}} +test timer-7.4 {GetAfterEvent procedure} { + list [catch {after info after#} msg] $msg +} {1 {event "after#" doesn't exist}} +test timer-7.5 {GetAfterEvent procedure} { + list [catch {after info after#${id}x} msg] $msg +} "1 {event \"after#${id}x\" doesn't exist}" +test timer-7.6 {GetAfterEvent procedure} { + list [catch {after info afterx[expr $id+1]} msg] $msg +} "1 {event \"afterx[expr $id+1]\" doesn't exist}" +after cancel $event + +test timer-8.1 {AfterProc procedure} { + set x before + proc foo {} { + set x untouched + after 100 {set x after} + after 200 + update + return $x + } + 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] + } + set x empty + after 100 {error "After error"} + after 200 + set y $x + update + catch {rename bgerror {}} + list $y $x +} {empty {{After error} {After error + while executing +"error "After error"" + ("after" script)}}} +test timer-8.3 {AfterProc procedure, deleting handler from itself} { + foreach i [after info] { + after cancel $i + } + proc foo {} { + global x + set x {} + foreach i [after info] { + lappend x [after info $i] + } + after cancel foo + } + after idle foo + after 1000 {error "I shouldn't ever have executed"} + update idletasks + set x +} {{{error "I shouldn't ever have executed"} timer}} +test timer-8.4 {AfterProc procedure, deleting handler from itself} { + foreach i [after info] { + after cancel $i + } + proc foo {} { + global x + set x {} + foreach i [after info] { + lappend x [after info $i] + } + after cancel foo + } + after 1000 {error "I shouldn't ever have executed"} + after idle foo + update idletasks + set x +} {{{error "I shouldn't ever have executed"} timer}} + +foreach i [after info] { + after cancel $i +} + +# No test for FreeAfterPtr, since it is already tested above. + + +test timer-9.1 {AfterCleanupProc procedure} { + catch {interp delete x} + interp create x + x eval {after 200 { + lappend x after + puts "part 1: this message should not appear" + }} + after 200 {lappend x after2} + x eval {after 200 { + lappend x after3 + puts "part 2: this message should not appear" + }} + after 200 {lappend x after4} + x eval {after 200 { + lappend x after5 + puts "part 3: this message should not appear" + }} + interp delete x + set x before + after 300 + update + set x +} {before after2 after4} + |