diff options
Diffstat (limited to 'contrib/tcl/tests/timer.test')
| -rw-r--r-- | contrib/tcl/tests/timer.test | 455 |
1 files changed, 0 insertions, 455 deletions
diff --git a/contrib/tcl/tests/timer.test b/contrib/tcl/tests/timer.test deleted file mode 100644 index 4671366c0b57..000000000000 --- a/contrib/tcl/tests/timer.test +++ /dev/null @@ -1,455 +0,0 @@ -# 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} - |