diff options
Diffstat (limited to 'contrib/tcl/tests/event.test')
| -rw-r--r-- | contrib/tcl/tests/event.test | 927 |
1 files changed, 927 insertions, 0 deletions
diff --git a/contrib/tcl/tests/event.test b/contrib/tcl/tests/event.test new file mode 100644 index 0000000..b48ee22 --- /dev/null +++ b/contrib/tcl/tests/event.test @@ -0,0 +1,927 @@ +# This file contains a collection of tests for the procedures in the file +# tclEvent.c, which includes the "after", "update", and "vwait" Tcl +# commands. Sourcing this file into Tcl runs the tests and generates +# output for errors. No output means no errors were found. +# +# Copyright (c) 1995-1996 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# "@(#) event.test 1.20 96/04/09 15:54:05" + +if {[string compare test [info procs test]] == 1} then {source defs} + +if {[catch {testfilehandler create 0 off off}] == 0 } { + test event-1.1 {Tcl_CreateFileHandler, reading} { + testfilehandler close + testfilehandler create 0 readable off + testfilehandler clear 0 + testfilehandler oneevent + set result "" + lappend result [testfilehandler counts 0] + testfilehandler fillpartial 0 + testfilehandler oneevent + lappend result [testfilehandler counts 0] + testfilehandler oneevent + lappend result [testfilehandler counts 0] + testfilehandler close + set result + } {{0 0} {1 0} {2 0}} + test event-1.2 {Tcl_CreateFileHandler, writing} {nonPortable} { + # This test is non-portable because on some systems (e.g. + # SunOS 4.1.3) pipes seem to be writable always. + testfilehandler close + testfilehandler create 0 off writable + testfilehandler clear 0 + testfilehandler oneevent + set result "" + lappend result [testfilehandler counts 0] + testfilehandler fillpartial 0 + testfilehandler oneevent + lappend result [testfilehandler counts 0] + testfilehandler fill 0 + testfilehandler oneevent + lappend result [testfilehandler counts 0] + testfilehandler close + set result + } {{0 1} {0 2} {0 2}} + test event-1.3 {Tcl_DeleteFileHandler} { + testfilehandler close + testfilehandler create 2 disabled disabled + testfilehandler create 1 readable writable + testfilehandler create 0 disabled disabled + testfilehandler fillpartial 1 + set result "" + testfilehandler oneevent + lappend result [testfilehandler counts 1] + testfilehandler oneevent + lappend result [testfilehandler counts 1] + testfilehandler oneevent + lappend result [testfilehandler counts 1] + testfilehandler create 1 off off + testfilehandler oneevent + lappend result [testfilehandler counts 1] + testfilehandler close + set result + } {{0 1} {1 1} {1 2} {0 0}} + + test event-2.1 {Tcl_DeleteFileHandler} { + testfilehandler close + testfilehandler create 2 disabled disabled + testfilehandler create 1 readable writable + testfilehandler fillpartial 1 + set result "" + testfilehandler oneevent + lappend result [testfilehandler counts 1] + testfilehandler oneevent + lappend result [testfilehandler counts 1] + testfilehandler oneevent + lappend result [testfilehandler counts 1] + testfilehandler create 1 off off + testfilehandler oneevent + lappend result [testfilehandler counts 1] + testfilehandler close + set result + } {{0 1} {1 1} {1 2} {0 0}} + test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} { + testfilehandler close + testfilehandler create 0 readable writable + testfilehandler fillpartial 0 + set result "" + testfilehandler oneevent + lappend result [testfilehandler counts 0] + testfilehandler close + testfilehandler create 0 readable writable + testfilehandler oneevent + lappend result [testfilehandler counts 0] + testfilehandler close + set result + } {{0 1} {0 0}} + + test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } { + testfilehandler close + testfilehandler create 1 readable writable + testfilehandler fillpartial 1 + testfilehandler windowevent + set result [testfilehandler counts 1] + testfilehandler close + set result + } {0 0} + + test event-4.1 {FileHandlerEventProc, race between event and disabling } { + testfilehandler close + testfilehandler create 2 disabled disabled + testfilehandler create 1 readable writable + testfilehandler fillpartial 1 + set result "" + testfilehandler oneevent + lappend result [testfilehandler counts 1] + testfilehandler oneevent + lappend result [testfilehandler counts 1] + testfilehandler oneevent + lappend result [testfilehandler counts 1] + testfilehandler create 1 disabled disabled + testfilehandler oneevent + lappend result [testfilehandler counts 1] + testfilehandler close + set result + } {{0 1} {1 1} {1 2} {0 0}} + test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off } { + testfilehandler close + testfilehandler create 1 readable writable + testfilehandler create 2 readable writable + testfilehandler fillpartial 1 + testfilehandler fillpartial 2 + testfilehandler oneevent + set result "" + lappend result [testfilehandler counts 1] [testfilehandler counts 2] + testfilehandler windowevent + lappend result [testfilehandler counts 1] [testfilehandler counts 2] + testfilehandler close + set result + } {{0 0} {0 1} {0 0} {0 1}} + testfilehandler close + update +} + +test event-5.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 200 + update + set x +} {50 100 150 200} + +test event-6.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 200 + update + set x +} {100 200} + +if {[info commands testmodal] != ""} { + test event-7.1 {Tcl_CreateModalTimeout and Tcl_DeleteModalTimeout procedures} { + update + set x {} + set result {} + testmodal create 50 first + testmodal create 200 second + after 100 + testmodal eventnotimers + lappend result $x + after 150 + testmodal eventnotimers + lappend result $x + testmodal delete + testmodal eventnotimers + lappend result $x + testmodal eventnotimers + lappend result $x + testmodal delete + testmodal eventnotimers + lappend result $x + } {{} second {second first} {second first first} {second first first}} + + test event-8.1 {TimerHandlerSetupProc procedure, choosing correct timer} { + update + set x {} + after 100 {lappend x normal} + testmodal create 200 modal + vwait x + testmodal delete + set x + } {normal} + test event-8.2 {TimerHandlerSetupProc procedure, choosing correct timer} { + update + set x {} + after 200 {lappend x normal} + testmodal create 100 modal + vwait x + testmodal delete + set x + } {modal} +} + +# No tests for TimerHandlerCheckProc: it's already tested by other tests +# above and below. + +test event-9.1 {TimerHandlerEventProc procedure} { + foreach i [after info] { + after cancel $i + } + foreach i {100 200 300} { + after $i lappend x $i + } + after 100 + set result "" + set x "" + update + lappend result $x + after 100 + update + lappend result $x + after 100 + update + lappend result $x +} {100 {100 200} {100 200 300}} + +# No tests for Tcl_DoWhenIdle: it's already tested by other tests +# below. + +test event-10.1 {Tk_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 event-10.2 {Tk_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 event-11.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 event-12.1 {Tcl_BackgroundError, HandleBgErrors procedures} { + catch {rename bgerror {}} + proc bgerror msg { + global errorInfo errorCode x + lappend x [list $msg $errorInfo $errorCode] + } + after idle {error "a simple error"} + after idle {open non_existent} + after idle {set errorInfo foobar; set errorCode xyzzy} + set x {} + update idletasks + rename bgerror {} + set x +} {{{a simple error} {a simple error + while executing +"error "a simple error"" + ("after" script)} NONE} {{couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory + while executing +"open non_existent" + ("after" script)} {POSIX ENOENT {no such file or directory}}}} +test event-12.2 {Tcl_BackgroundError, HandleBgErrors procedures} { + catch {rename bgerror {}} + proc bgerror msg { + global x + lappend x $msg + return -code break + } + after idle {error "a simple error"} + after idle {open non_existent} + set x {} + update idletasks + rename bgerror {} + set x +} {{a simple error}} + +test event-13.1 {BgErrorDeleteProc procedure} { + catch {interp delete foo} + interp create foo + foo eval { + proc bgerror args { + global errorInfo + set f [open err.out r+] + seek $f 0 end + puts $f "$args $errorInfo" + close $f + } + after 100 {error "first error"} + after 100 {error "second error"} + } + makeFile Unmodified err.out + after 100 {interp delete foo} + after 200 + update + set f [open err.out r] + set result [read $f] + close $f + removeFile err.out + set result +} {Unmodified +} + +test event-14.1 {tkerror/bgerror backwards compabitility} { + catch {rename bgerror {}} + proc tkerror {x y} { + return [expr $x + $y] + } + list [tkerror 4 7] [bgerror 8 -3] +} {11 5} +test event-14.2 {tkerror/bgerror backwards compabitility} { + proc bgerror {x y} { + return [expr 1 + $x + $y] + } + list [tkerror 6 -2] [bgerror 7 2] +} {5 10} +test event-14.3 {tkerror/bgerror backwards compabitility} { + proc bgerror {x y} { + return [expr 1 + $x + $y] + } + set result [list [info commands bgerror] [info commands tkerror]] + rename tkerror {} + lappend result [info commands bgerror] [info commands tkerror] +} {bgerror tkerror {} {}} +test event-14.4 {tkerror/bgerror backwards compabitility} { + proc tkerror {x y} { + return [expr 1 + $x + $y] + } + set result [list [info commands bgerror] [info commands tkerror]] + rename bgerror {} + lappend result [info commands bgerror] [info commands tkerror] +} {bgerror tkerror {} {}} +test event-14.5 {tkerror/bgerror backwards compabitility} { + proc tkerror {x y} { + return [expr 1 + $x + $y] + } + rename tkerror foo + list [info commands bgerror] [info commands tkerror] [foo 4 3] +} {{} {} 8} +test event-14.6 {tkerror/bgerror backwards compabitility} { + proc bgerror {x y} { + return [expr 1 + $x + $y] + } + catch {rename foo {}} + rename bgerror foo + list [info commands bgerror] [info commands tkerror] [foo 4 3] +} {{} {} 8} +test event-14.7 {tkerror/bgerror backwards compabitility} { + proc foo args {return $args} + catch {rename tkerror {}} + rename foo tkerror + list [info commands bgerror] [info commands tkerror] [info commands foo] [tkerror a b c d] +} {bgerror tkerror {} {a b c d}} +test event-14.8 {tkerror/bgerror backwards compabitility} { + proc foo args {return $args} + catch {rename bgerror {}} + rename foo bgerror + list [info commands bgerror] [info commands tkerror] [info commands foo] [tkerror a b c d] +} {bgerror tkerror {} {a b c d}} +test event-14.9 {tkerror/bgerror backwards compabitility} { + proc bgerror args {return $args} + list [catch {rename bgerror tkerror} msg] $msg +} {1 {can't rename to "tkerror": command already exists}} +rename bgerror {} + +if {[info commands testexithandler] != ""} { + test event-15.1 {Tcl_CreateExitHandler procedure} {unixOrPc} { + set child [open |[list [info nameofexecutable]] r+] + puts $child "testexithandler create 41; testexithandler create 4" + puts $child "testexithandler create 6; exit" + flush $child + set result [read $child] + close $child + set result + } {even 6 +even 4 +odd 41 +} + + test event-16.1 {Tcl_DeleteExitHandler procedure} {unixOrPc} { + set child [open |[list [info nameofexecutable]] r+] + puts $child "testexithandler create 41; testexithandler create 4" + puts $child "testexithandler create 6; testexithandler delete 41" + puts $child "testexithandler create 16; exit" + flush $child + set result [read $child] + close $child + set result + } {even 16 +even 6 +even 4 +} + test event-16.2 {Tcl_DeleteExitHandler procedure} {unixOrPc} { + set child [open |[list [info nameofexecutable]] r+] + puts $child "testexithandler create 41; testexithandler create 4" + puts $child "testexithandler create 6; testexithandler delete 4" + puts $child "testexithandler create 16; exit" + flush $child + set result [read $child] + close $child + set result + } {even 16 +even 6 +odd 41 +} + test event-16.3 {Tcl_DeleteExitHandler procedure} {unixOrPc} { + set child [open |[list [info nameofexecutable]] r+] + puts $child "testexithandler create 41; testexithandler create 4" + puts $child "testexithandler create 6; testexithandler delete 6" + puts $child "testexithandler create 16; exit" + flush $child + set result [read $child] + close $child + set result + } {even 16 +even 4 +odd 41 +} + test event-16.4 {Tcl_DeleteExitHandler procedure} {unixOrPc} { + set child [open |[list [info nameofexecutable]] r+] + puts $child "testexithandler create 41; testexithandler delete 41" + puts $child "testexithandler create 16; exit" + flush $child + set result [read $child] + close $child + set result + } {even 16 +} +} + +test event-17.1 {Tcl_Exit procedure} {unixOrPc} { + set child [open |[list [info nameofexecutable]] r+] + puts $child "exit 3" + list [catch {close $child} msg] $msg [lindex $errorCode 0] \ + [lindex $errorCode 2] +} {1 {child process exited abnormally} CHILDSTATUS 3} + +test event-18.1 {Tcl_AfterCmd procedure, basics} { + list [catch {after} msg] $msg +} {1 {wrong # args: should be "after option ?arg arg ...?"}} +test event-18.2 {Tcl_AfterCmd procedure, basics} { + list [catch {after 2x} msg] $msg +} {1 {expected integer but got "2x"}} +test event-18.3 {Tcl_AfterCmd procedure, basics} { + list [catch {after gorp} msg] $msg +} {1 {bad argument "gorp": must be cancel, idle, info, or a number}} +test event-18.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 event-18.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 event-18.6 {Tcl_AfterCmd procedure, cancel option} { + list [catch {after cancel} msg] $msg +} {1 {wrong # args: should be "after cancel id|command"}} +test event-18.7 {Tcl_AfterCmd procedure, cancel option} { + after cancel after#1 +} {} +test event-18.8 {Tcl_AfterCmd procedure, cancel option} { + after cancel {foo bar} +} {} +test event-18.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 event-18.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 event-18.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 event-18.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 event-18.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 event-18.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 event-18.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} { + foreach i [after info] { + after cancel $i + } + 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}] + interp delete x + set result +} {2 0 aaa bbb {before b-after}} +test event-18.16 {Tcl_AfterCmd procedure, idle option} { + list [catch {after idle} msg] $msg +} {1 {wrong # args: should be "after idle script script ..."}} +test event-18.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 event-18.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 event-18.19 {Tcl_AfterCmd, info option} { + lsort [after info] +} "$event1 $event2" +test event-18.20 {Tcl_AfterCmd, info option} { + list [catch {after info a b} msg] $msg +} {1 {wrong # args: should be "after info ?id?"}} +test event-18.21 {Tcl_AfterCmd, info option} { + list [catch {after info $childEvent} msg] $msg +} "1 {event \"$childEvent\" doesn't exist}" +test event-18.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 + +set event [after idle foo bar] +scan $event after#%d id +test event-19.1 {GetAfterEvent procedure} { + list [catch {after info xfter#$id} msg] $msg +} "1 {event \"xfter#$id\" doesn't exist}" +test event-19.2 {GetAfterEvent procedure} { + list [catch {after info afterx$id} msg] $msg +} "1 {event \"afterx$id\" doesn't exist}" +test event-19.3 {GetAfterEvent procedure} { + list [catch {after info after#ab} msg] $msg +} {1 {event "after#ab" doesn't exist}} +test event-19.4 {GetAfterEvent procedure} { + list [catch {after info after#} msg] $msg +} {1 {event "after#" doesn't exist}} +test event-19.5 {GetAfterEvent procedure} { + list [catch {after info after#${id}x} msg] $msg +} "1 {event \"after#${id}x\" doesn't exist}" +test event-19.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 event-20.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 event-20.2 {AfterProc procedure} { + catch {rename bgerror {}} + proc bgerror msg { + global x errorInfo + set x [list $msg $errorInfo] + } + set x empty + after 100 {error "After error"} + after 200 + set y $x + update + catch {rename bgerror {}} + list $y $x +} {empty {{After error} {After error + while executing +"error "After error"" + ("after" script)}}} +test event-20.3 {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 idle foo + after 1000 {error "I shouldn't ever have executed"} + update idletasks + set x +} {{{error "I shouldn't ever have executed"} timer}} +test event-20.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 + } + +test event-21.1 {AfterCleanupProc procedure} { + catch {interp delete x} + 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 + set x +} {before after2 after4} + +test event-22.1 {Tcl_VwaitCmd procedure} { + list [catch {vwait} msg] $msg +} {1 {wrong # args: should be "vwait name"}} +test event-22.2 {Tcl_VwaitCmd procedure} { + list [catch {vwait a b} msg] $msg +} {1 {wrong # args: should be "vwait name"}} +test event-22.3 {Tcl_VwaitCmd procedure} { + foreach i [after info] { + after cancel $i + } + after 100 {set x x-done} + after 200 {set y y-done} + after 300 {set z z-done} + after idle {set q q-done} + set x before + set y before + set z before + set q before + list [vwait y] $x $y $z $q +} {{} x-done y-done before q-done} + +test event-23.1 {Tcl_UpdateCmd procedure} { + list [catch {update a b} msg] $msg +} {1 {wrong # args: should be "update ?idletasks?"}} +test event-23.2 {Tcl_UpdateCmd procedure} { + list [catch {update bogus} msg] $msg +} {1 {bad option "bogus": must be idletasks}} +test event-23.3 {Tcl_UpdateCmd procedure} { + foreach i [after info] { + after cancel $i + } + after 500 {set x after} + after idle {set y after} + after idle {set z "after, y = $y"} + set x before + set y before + set z before + update idletasks + list $x $y $z +} {before after {after, y = after}} +test event-23.4 {Tcl_UpdateCmd procedure} { + foreach i [after info] { + after cancel $i + } + after 200 {set x x-done} + after 500 {set y y-done} + after idle {set z z-done} + set x before + set y before + set z before + after 300 + update + list $x $y $z +} {x-done before z-done} + +if {[info commands testfilehandler] != ""} { + test event-24.1 {Tcl_WaitForFile procedure, readable} unixOnly { + foreach i [after info] { + after cancel $i + } + after 100 set x timeout + testfilehandler close + testfilehandler create 1 off off + set x "no timeout" + set result [testfilehandler wait 1 readable 0] + update + testfilehandler close + list $result $x + } {{} {no timeout}} + test event-24.2 {Tcl_WaitForFile procedure, readable} unixOnly { + foreach i [after info] { + after cancel $i + } + after 100 set x timeout + testfilehandler close + testfilehandler create 1 off off + set x "no timeout" + set result [testfilehandler wait 1 readable 100] + update + testfilehandler close + list $result $x + } {{} timeout} + test event-24.3 {Tcl_WaitForFile procedure, readable} unixOnly { + foreach i [after info] { + after cancel $i + } + after 100 set x timeout + testfilehandler close + testfilehandler create 1 off off + testfilehandler fillpartial 1 + set x "no timeout" + set result [testfilehandler wait 1 readable 100] + update + testfilehandler close + list $result $x + } {readable {no timeout}} + test event-24.4 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} { + foreach i [after info] { + after cancel $i + } + after 100 set x timeout + testfilehandler close + testfilehandler create 1 off off + testfilehandler fill 1 + set x "no timeout" + set result [testfilehandler wait 1 writable 0] + update + testfilehandler close + list $result $x + } {{} {no timeout}} + test event-24.5 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} { + foreach i [after info] { + after cancel $i + } + after 100 set x timeout + testfilehandler close + testfilehandler create 1 off off + testfilehandler fill 1 + set x "no timeout" + set result [testfilehandler wait 1 writable 100] + update + testfilehandler close + list $result $x + } {{} timeout} + test event-24.6 {Tcl_WaitForFile procedure, writable} unixOnly { + foreach i [after info] { + after cancel $i + } + after 100 set x timeout + testfilehandler close + testfilehandler create 1 off off + set x "no timeout" + set result [testfilehandler wait 1 writable 100] + update + testfilehandler close + list $result $x + } {writable {no timeout}} + test event-24.7 {Tcl_WaitForFile procedure, don't call other event handlers} unixOnly { + foreach i [after info] { + after cancel $i + } + after 100 lappend x timeout + after idle lappend x idle + testfilehandler close + testfilehandler create 1 off off + set x "" + set result [list [testfilehandler wait 1 readable 200] $x] + update + testfilehandler close + lappend result $x + } {{} {} {timeout idle}} + test event-24.8 {Tcl_WaitForFile procedure, waiting indefinitely} unixOnly { + set f [open "|sleep 2" r] + set result "" + lappend result [testfilewait $f readable 100] + lappend result [testfilewait $f readable -1] + close $f + set result + } {{} readable} +} + +foreach i [after info] { + after cancel $i +} |
