# 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. # # RCS: @(#) $Id: timer.test,v 1.7.2.1 2001/10/13 01:14:19 hobbs Exp $ source testing.tcl 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 210 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 210 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 210 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 310 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 ...?"}} test timer-6.2 {Tcl_AfterCmd procedure, basics} { list [catch {after 2x} msg] $msg } {1 {bad argument "2x": must be cancel, idle, or info}} test timer-6.3 {Tcl_AfterCmd procedure, basics} { 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} { 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.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] test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NULL} { foreach i [after info] { after cancel $i } set x "hello world" after 1 "set x ab\0cd" after 10 update string length $x } {5} test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NULL} { foreach i [after info] { after cancel $i } set x "hello world" after 1 set x ab\0cd after 10 update string length $x } {5} test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NULL} { foreach i [after info] { after cancel $i } set x "hello world" after 1 set x ab\0cd after cancel "set x ab\0ef" set x [llength [after info]] foreach i [after info] { after cancel $i } set x } {1} test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NULL} { foreach i [after info] { after cancel $i } set x "hello world" after 1 set x ab\0cd after cancel set x ab\0ef set y [llength [after info]] foreach i [after info] { after cancel $i } set y } {1} test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NULL} { foreach i [after info] { after cancel $i } set x "hello world" after idle "set x ab\0cd" update string length $x } {5} test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NULL} { foreach i [after info] { after cancel $i } set x "hello world" after idle set x ab\0cd update string length $x } {5} test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NULL} { foreach i [after info] { after cancel $i } set x "hello world" set id junk set id [after 10 set x ab\0cd] update set y [string length [lindex [lindex [after info $id] 0] 2]] foreach i [after info] { after cancel $i } set y } {5} 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 { set ::x $msg } set x empty after 100 {error "After error"} after 200 set y $x update catch {rename bgerror {}} list $y $x } {empty {After error}} 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 } testreport