aboutsummaryrefslogtreecommitdiff
path: root/tests/timer.test
diff options
context:
space:
mode:
authorSteve Bennett <steveb@workware.net.au>2010-09-16 10:01:27 +1000
committerSteve Bennett <steveb@workware.net.au>2010-10-15 11:02:54 +1000
commitb4a77b8c3c18870009b5a2c193a1772552b5e4b5 (patch)
tree10bc85e5e1a702f07547b6cd0ee8fc077d03cd99 /tests/timer.test
parent1f3eccbfe50172710a1190bd1d13f03778d587a1 (diff)
downloadjimtcl-b4a77b8c3c18870009b5a2c193a1772552b5e4b5.zip
jimtcl-b4a77b8c3c18870009b5a2c193a1772552b5e4b5.tar.gz
jimtcl-b4a77b8c3c18870009b5a2c193a1772552b5e4b5.tar.bz2
eventloop improvements and enhancements
Move Jim_EvalObjBackground() out of the core to eventloop Time events are now kept and triggered in time order Time handlers are removed before execution Add 'update' Add 'after info' and 'after idle' Include time events in the return from Jim_ProcessEvents() Add Tcl eventloop tests Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'tests/timer.test')
-rw-r--r--tests/timer.test455
1 files changed, 455 insertions, 0 deletions
diff --git a/tests/timer.test b/tests/timer.test
new file mode 100644
index 0000000..d1c7e1f
--- /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.
+# 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