diff options
Diffstat (limited to 'tcl8.6/tests/timer.test')
-rw-r--r-- | tcl8.6/tests/timer.test | 605 |
1 files changed, 0 insertions, 605 deletions
diff --git a/tcl8.6/tests/timer.test b/tcl8.6/tests/timer.test deleted file mode 100644 index ab6efc9..0000000 --- a/tcl8.6/tests/timer.test +++ /dev/null @@ -1,605 +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. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} - -test timer-1.1 {Tcl_CreateTimerHandler procedure} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x "" - foreach i {100 200 1000 50 150} { - after $i lappend x $i - } - after 200 set done 1 - vwait done - return $x -} -cleanup { - foreach i [after info] { - after cancel $i - } -} -result {50 100 150 200} - -test timer-2.1 {Tcl_DeleteTimerHandler procedure} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x "" - foreach i {100 200 1000 50 150} { - after $i lappend x $i - } - after cancel lappend x 150 - after cancel lappend x 50 - after 200 set done 1 - vwait done - return $x -} -result {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} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - 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 -} -result {200 {200 600} {200 600 1000}} -test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x {} - after 100 lappend x 100 - set i [after 300 lappend x 300] - after 200 after cancel $i - after 400 - update - return $x -} -result 100 -test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x {} - after 100 lappend x a - after 200 lappend x b - after 300 lappend x c - after 300 - vwait x - return $x -} -result {a b c} -test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x {} - after 100 {lappend x a; after 0 lappend x b} - after 100 - vwait x - return $x -} -result a -test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - 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 -} -result {a {a b}} - -# No tests for Tcl_DoWhenIdle: it's already tested by other tests -# below. - -test timer-4.1 {Tcl_CancelIdleCall procedure} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - 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 - list $x $y $z -} -result {after1 before after3} -test timer-4.2 {Tcl_CancelIdleCall procedure} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - 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 - list $x $y $z -} -result {before after2 after3} - -test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - 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 -} -result {2 24 4} - -test timer-6.1 {Tcl_AfterCmd procedure, basics} -returnCodes error -body { - after -} -result {wrong # args: should be "after option ?arg ...?"} -test timer-6.2 {Tcl_AfterCmd procedure, basics} -returnCodes error -body { - after 2x -} -result {bad argument "2x": must be cancel, idle, info, or an integer} -test timer-6.3 {Tcl_AfterCmd procedure, basics} -returnCodes error -body { - after gorp -} -result {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} - 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} -body { - after cancel -} -returnCodes error -result {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} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x before - set y [after 100 set x after] - after cancel $y - after 200 - update - return $x -} -result {before} -test timer-6.10 {Tcl_AfterCmd procedure, cancel option} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x before - after 100 set x after - after cancel {set x after} - after 200 - update - return $x -} -result {before} -test timer-6.11 {Tcl_AfterCmd procedure, cancel option} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - 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 -} -result {after cleared} -test timer-6.12 {Tcl_AfterCmd procedure, cancel option} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - 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 - return $x -} -result {first third} -test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - 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 - return $x -} -result {first third} -test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set id [ - after 100 { - set x done - after cancel $id - } - ] - vwait x -} -result {} -test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - 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}] -} -cleanup { - interp delete x -} -result {2 0 aaa bbb {before b-after}} -test timer-6.16 {Tcl_AfterCmd procedure, idle option} -body { - after idle -} -returnCodes error -result {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} -returnCodes error -body { - after info a b -} -result {wrong # args: should be "after info ?id?"} -test timer-6.21 {Tcl_AfterCmd, info option} -returnCodes error -body { - after info $childEvent -} -result "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 - -test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NUL} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x "hello world" - after 1 "set x ab\0cd" - after 10 - update - string length $x -} -result {5} -test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NUL} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x "hello world" - after 1 set x ab\0cd - after 10 - update - string length $x -} -result {5} -test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x "hello world" - after 1 set x ab\0cd - after cancel "set x ab\0ef" - llength [after info] -} -cleanup { - foreach i [after info] { - after cancel $i - } -} -result {1} -test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x "hello world" - after 1 set x ab\0cd - after cancel set x ab\0ef - llength [after info] -} -cleanup { - foreach i [after info] { - after cancel $i - } -} -result {1} -test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x "hello world" - after idle "set x ab\0cd" - update - string length $x -} -result {5} -test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x "hello world" - after idle set x ab\0cd - update - string length $x -} -result {5} -test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NUL} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - set x "hello world" - set id junk - set id [after 10 set x ab\0cd] - update - string length [lindex [lindex [after info $id] 0] 2] -} -cleanup { - foreach i [after info] { - after cancel $i - } -} -result 5 - -set event [after idle foo bar] -scan $event after#%d lastId -test timer-7.1 {GetAfterEvent procedure} -returnCodes error -body { - after info xfter#$lastId -} -result "event \"xfter#$lastId\" doesn't exist" -test timer-7.2 {GetAfterEvent procedure} -returnCodes error -body { - after info afterx$lastId -} -result "event \"afterx$lastId\" doesn't exist" -test timer-7.3 {GetAfterEvent procedure} -returnCodes error -body { - after info after#ab -} -result {event "after#ab" doesn't exist} -test timer-7.4 {GetAfterEvent procedure} -returnCodes error -body { - after info after# -} -result {event "after#" doesn't exist} -test timer-7.5 {GetAfterEvent procedure} -returnCodes error -body { - after info after#${lastId}x -} -result "event \"after#${lastId}x\" doesn't exist" -test timer-7.6 {GetAfterEvent procedure} -returnCodes error -body { - after info afterx[expr {$lastId+1}] -} -result "event \"afterx[expr {$lastId+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} -setup { - variable x empty - proc myHandler {msg options} { - variable x [list $msg [dict get $options -errorinfo]] - } - set handler [interp bgerror {}] - interp bgerror {} [namespace which myHandler] -} -body { - after 100 {error "After error"} - after 200 - set y $x - update - list $y $x -} -cleanup { - interp bgerror {} $handler -} -result {empty {{After error} {After error - while executing -"error "After error"" - ("after" script)}}} -test timer-8.3 {AfterProc procedure, deleting handler from itself} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - 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 - return $x -} -result {{{error "I shouldn't ever have executed"} timer}} -test timer-8.4 {AfterProc procedure, deleting handler from itself} -setup { - foreach i [after info] { - after cancel $i - } -} -body { - 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 - return $x -} -result {{{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} -setup { - catch {interp delete x} -} -body { - 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 - return $x -} -result {before after2 after4} - -test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup { - interp create slave - slave eval namespace export after - slave eval namespace eval foo namespace import ::after -} -body { - slave eval foo::after 1 - slave eval namespace origin foo::after -} -cleanup { - # Bug will cause crash here; would cause failure otherwise - 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 - return $b -} -cleanup { - catch {after cancel $a} -} -result ok -test timer-11.2 {Bug 1350293: [after] negative argument} -body { - set l {} - after 100 {lappend l 100; set done 1} - after -1 {lappend l -1} - vwait done - return $l -} -result {-1 100} - -# cleanup -::tcltest::cleanupTests -return - -# Local Variables: -# mode: tcl -# End: |