summaryrefslogtreecommitdiffstats
path: root/tcl8.6/tests/timer.test
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2018-01-02 20:34:49 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2018-01-02 20:34:49 (GMT)
commit89c1ac99d375fbd73892aa659f06ef5e2c5ea56e (patch)
treee76ce80d68d11f1ea137bc33a42f71a1d1f32028 /tcl8.6/tests/timer.test
parent01e4cd2ef2ff59418766b2259fbc99771646aba6 (diff)
downloadblt-89c1ac99d375fbd73892aa659f06ef5e2c5ea56e.zip
blt-89c1ac99d375fbd73892aa659f06ef5e2c5ea56e.tar.gz
blt-89c1ac99d375fbd73892aa659f06ef5e2c5ea56e.tar.bz2
upgrade to tcl/tk 8.6.8
Diffstat (limited to 'tcl8.6/tests/timer.test')
-rw-r--r--tcl8.6/tests/timer.test605
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: