summaryrefslogtreecommitdiffstats
path: root/tests/timer.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/timer.test')
-rw-r--r--tests/timer.test306
1 files changed, 142 insertions, 164 deletions
diff --git a/tests/timer.test b/tests/timer.test
index ab6efc9..db508e5 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -14,33 +14,27 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+ package require tcltest
namespace import -force ::tcltest::*
}
-test timer-1.1 {Tcl_CreateTimerHandler procedure} -setup {
+test timer-1.1 {Tcl_CreateTimerHandler procedure} {
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}
+ set x
+} {50 100 150 200}
-test timer-2.1 {Tcl_DeleteTimerHandler procedure} -setup {
+test timer-2.1 {Tcl_DeleteTimerHandler procedure} {
foreach i [after info] {
after cancel $i
}
-} -body {
set x ""
foreach i {100 200 1000 50 150} {
after $i lappend x $i
@@ -49,8 +43,8 @@ test timer-2.1 {Tcl_DeleteTimerHandler procedure} -setup {
after cancel lappend x 50
after 200 set done 1
vwait done
- return $x
-} -result {100 200}
+ set x
+} {100 200}
# No tests for Tcl_ServiceTimer or ResetTimer, since it is already tested
# above.
@@ -64,11 +58,10 @@ test timer-3.1 {TimerHandlerEventProc procedure: event masks} {
update
lappend result $x
} {start fired}
-test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} -setup {
+test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} {
foreach i [after info] {
after cancel $i
}
-} -body {
foreach i {200 600 1000} {
after $i lappend x $i
}
@@ -83,49 +76,45 @@ test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} -setup {
after 400
update
lappend result $x
-} -result {200 {200 600} {200 600 1000}}
-test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} -setup {
+} {200 {200 600} {200 600 1000}}
+test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} {
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 {
+ set x
+} 100
+test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} {
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 {
+ set x
+} {a b c}
+test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {
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 {
+ set x
+} a
+test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {
foreach i [after info] {
after cancel $i
}
-} -body {
set x {}
after 100 {lappend x a; after 100 lappend x b; after 100}
after 100
@@ -133,16 +122,15 @@ test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't
set result $x
vwait x
lappend result $x
-} -result {a {a b}}
+} {a {a b}}
# No tests for Tcl_DoWhenIdle: it's already tested by other tests
# below.
-test timer-4.1 {Tcl_CancelIdleCall procedure} -setup {
+test timer-4.1 {Tcl_CancelIdleCall procedure} {
foreach i [after info] {
after cancel $i
}
-} -body {
set x before
set y before
set z before
@@ -151,13 +139,12 @@ test timer-4.1 {Tcl_CancelIdleCall procedure} -setup {
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 {
+ concat $x $y $z
+} {after1 before after3}
+test timer-4.2 {Tcl_CancelIdleCall procedure} {
foreach i [after info] {
after cancel $i
}
-} -body {
set x before
set y before
set z before
@@ -166,14 +153,13 @@ test timer-4.2 {Tcl_CancelIdleCall procedure} -setup {
after idle set z after3
after cancel set x after1
update idletasks
- list $x $y $z
-} -result {before after2 after3}
+ concat $x $y $z
+} {before after2 after3}
-test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} -setup {
+test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} {
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}}}
@@ -182,17 +168,17 @@ test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} -setup {
set result "$x $y"
update idletasks
lappend result $x
-} -result {2 24 4}
+} {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.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 {bad argument "2x": must be cancel, idle, info, or an integer}}
+test timer-6.3 {Tcl_AfterCmd procedure, basics} {
+ list [catch {after gorp} msg] $msg
+} {1 {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}
@@ -213,44 +199,41 @@ test timer-6.5 {Tcl_AfterCmd procedure, ms argument} {
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.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} -setup {
+test timer-6.9 {Tcl_AfterCmd procedure, cancel option} {
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 {
+ set x
+} {before}
+test timer-6.10 {Tcl_AfterCmd procedure, cancel option} {
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 {
+ set x
+} {before}
+test timer-6.11 {Tcl_AfterCmd procedure, cancel option} {
foreach i [after info] {
after cancel $i
}
-} -body {
set x before
after 100 set x after
set id [after 300 set x after]
@@ -262,12 +245,11 @@ test timer-6.11 {Tcl_AfterCmd procedure, cancel option} -setup {
after 200
update
list $y $x
-} -result {after cleared}
-test timer-6.12 {Tcl_AfterCmd procedure, cancel option} -setup {
+} {after cleared}
+test timer-6.12 {Tcl_AfterCmd procedure, cancel option} {
foreach i [after info] {
after cancel $i
}
-} -body {
set x first
after idle lappend x second
after idle lappend x third
@@ -275,13 +257,12 @@ test timer-6.12 {Tcl_AfterCmd procedure, cancel option} -setup {
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 {
+ set x
+} {first third}
+test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} {
foreach i [after info] {
after cancel $i
}
-} -body {
set x first
after idle lappend x second
after idle lappend x third
@@ -289,13 +270,12 @@ test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for c
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 {
+ 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
}
-} -body {
set id [
after 100 {
set x done
@@ -303,12 +283,11 @@ test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, u
}
]
vwait x
-} -result {}
-test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} -setup {
+} {}
+test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} {
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}}
@@ -320,12 +299,12 @@ test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} -setup
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 ...?"}
+ 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}
@@ -340,7 +319,6 @@ test timer-6.18 {Tcl_AfterCmd procedure, idle option} {
update idletasks
list $y $x
} {before after}
-
set event1 [after idle event 1]
set event2 [after 1000 event 2]
interp create x
@@ -348,125 +326,120 @@ 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.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
-test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NUL} -setup {
+test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NULL} {
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 {
+} {5}
+test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NULL} {
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 {
+} {5}
+test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NULL} {
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 {
+ set x [llength [after info]]
foreach i [after info] {
after cancel $i
}
-} -result {1}
-test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup {
+ set x
+} {1}
+test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NULL} {
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 {
+ set y [llength [after info]]
foreach i [after info] {
after cancel $i
}
-} -result {1}
-test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup {
+ set y
+} {1}
+test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NULL} {
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 {
+} {5}
+test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NULL} {
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 {
+} {5}
+test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NULL} {
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 {
+ set y [string length [lindex [lindex [after info $id] 0] 2]]
foreach i [after info] {
after cancel $i
}
-} -result 5
+ set y
+} {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"
+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} {
@@ -499,11 +472,10 @@ test timer-8.2 {AfterProc procedure} -setup {
while executing
"error "After error""
("after" script)}}}
-test timer-8.3 {AfterProc procedure, deleting handler from itself} -setup {
+test timer-8.3 {AfterProc procedure, deleting handler from itself} {
foreach i [after info] {
after cancel $i
}
-} -body {
proc foo {} {
global x
set x {}
@@ -515,13 +487,12 @@ test timer-8.3 {AfterProc procedure, deleting handler from itself} -setup {
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 {
+ 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
}
-} -body {
proc foo {} {
global x
set x {}
@@ -533,8 +504,8 @@ test timer-8.4 {AfterProc procedure, deleting handler from itself} -setup {
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}}
+ set x
+} {{{error "I shouldn't ever have executed"} timer}}
foreach i [after info] {
after cancel $i
@@ -542,9 +513,9 @@ foreach i [after info] {
# No test for FreeAfterPtr, since it is already tested above.
-test timer-9.1 {AfterCleanupProc procedure} -setup {
+
+test timer-9.1 {AfterCleanupProc procedure} {
catch {interp delete x}
-} -body {
interp create x
x eval {after 200 {
lappend x after
@@ -564,8 +535,8 @@ test timer-9.1 {AfterCleanupProc procedure} -setup {
set x before
after 300
update
- return $x
-} -result {before after2 after4}
+ set x
+} {before after2 after4}
test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup {
interp create slave
@@ -579,22 +550,29 @@ test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup {
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}
+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
+ set 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
+ set l
+ } \
+ -result {-1 100}
+
# cleanup
::tcltest::cleanupTests
generated by cgit v0.12 at 2025-01-12 14:05:31 (GMT)