diff options
Diffstat (limited to 'tests/event.test')
| -rw-r--r-- | tests/event.test | 771 |
1 files changed, 386 insertions, 385 deletions
diff --git a/tests/event.test b/tests/event.test index a7122f9..0ee7558 100644 --- a/tests/event.test +++ b/tests/event.test @@ -1,7 +1,7 @@ # This file contains a collection of tests for the procedures in the file -# tclEvent.c, which includes the "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. +# tclEvent.c, which includes the "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-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. @@ -15,30 +15,33 @@ namespace import -force ::tcltest::* testConstraint testfilehandler [llength [info commands testfilehandler]] testConstraint testexithandler [llength [info commands testexithandler]] testConstraint testfilewait [llength [info commands testfilewait]] - -test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler} { +testConstraint exec [llength [info commands exec]] + +test event-1.1 {Tcl_CreateFileHandler, reading} -setup { testfilehandler close + set result "" +} -constraints {testfilehandler} -body { 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] +} -cleanup { testfilehandler close - set result -} {{0 0} {1 0} {2 0}} -test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} { - # This test is non-portable because on some systems (e.g. - # SunOS 4.1.3) pipes seem to be writable always. +} -result {{0 0} {1 0} {2 0}} +test event-1.2 {Tcl_CreateFileHandler, writing} -setup { testfilehandler close + set result "" +} -constraints {testfilehandler nonPortable} -body { + # This test is non-portable because on some systems (e.g., SunOS 4.1.3) + # pipes seem to be writable always. testfilehandler create 0 off writable testfilehandler clear 0 testfilehandler oneevent - set result "" lappend result [testfilehandler counts 0] testfilehandler fillpartial 0 testfilehandler oneevent @@ -46,16 +49,17 @@ test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} { testfilehandler fill 0 testfilehandler oneevent lappend result [testfilehandler counts 0] +} -cleanup { testfilehandler close - set result -} {{0 1} {0 2} {0 2}} -test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} { +} -result {{0 1} {0 2} {0 2}} +test event-1.3 {Tcl_DeleteFileHandler} -setup { testfilehandler close + set result "" +} -constraints {testfilehandler nonPortable} -body { 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 @@ -65,16 +69,17 @@ test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} { testfilehandler create 1 off off testfilehandler oneevent lappend result [testfilehandler counts 1] +} -cleanup { testfilehandler close - set result -} {{0 1} {1 1} {1 2} {0 0}} +} -result {{0 1} {1 1} {1 2} {0 0}} -test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} { +test event-2.1 {Tcl_DeleteFileHandler} -setup { testfilehandler close + set result "" +} -constraints {testfilehandler nonPortable} -body { testfilehandler create 2 disabled disabled testfilehandler create 1 readable writable testfilehandler fillpartial 1 - set result "" testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler oneevent @@ -84,43 +89,44 @@ test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} { testfilehandler create 1 off off testfilehandler oneevent lappend result [testfilehandler counts 1] +} -cleanup { testfilehandler close - set result -} {{0 1} {1 1} {1 2} {0 0}} -test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} \ - {testfilehandler nonPortable} { +} -result {{0 1} {1 1} {1 2} {0 0}} +test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} -setup { testfilehandler close + set result "" +} -constraints {testfilehandler nonPortable} -body { 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] +} -cleanup { testfilehandler close - set result -} {{0 1} {0 0}} +} -result {{0 1} {0 0}} -test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {testfilehandler} { +test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off} -setup { testfilehandler close +} -constraints {testfilehandler} -body { testfilehandler create 1 readable writable testfilehandler fillpartial 1 testfilehandler windowevent - set result [testfilehandler counts 1] + testfilehandler counts 1 +} -cleanup { testfilehandler close - set result -} {0 0} +} -result {0 0} -test event-4.1 {FileHandlerEventProc, race between event and disabling} \ - {testfilehandler nonPortable} { +test event-4.1 {FileHandlerEventProc, race between event and disabling} -setup { update testfilehandler close + set result "" +} -constraints {testfilehandler nonPortable} -body { testfilehandler create 2 disabled disabled testfilehandler create 1 readable writable testfilehandler fillpartial 1 - set result "" testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler oneevent @@ -130,13 +136,13 @@ test event-4.1 {FileHandlerEventProc, race between event and disabling} \ testfilehandler create 1 disabled disabled testfilehandler oneevent lappend result [testfilehandler counts 1] +} -cleanup { testfilehandler close - set result -} {{0 1} {1 1} {1 2} {0 0}} -test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \ - {testfilehandler nonPortable} { +} -result {{0 1} {1 1} {1 2} {0 0}} +test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} -setup { update testfilehandler close +} -constraints {testfilehandler nonPortable} -body { testfilehandler create 1 readable writable testfilehandler create 2 readable writable testfilehandler fillpartial 1 @@ -146,13 +152,14 @@ test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \ lappend result [testfilehandler counts 1] [testfilehandler counts 2] testfilehandler windowevent lappend result [testfilehandler counts 1] [testfilehandler counts 2] +} -cleanup { testfilehandler close - set result -} {{0 0} {0 1} {0 0} {0 1}} +} -result {{0 0} {0 1} {0 0} {0 1}} update -test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} { +test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} -setup { catch {rename bgerror {}} +} -body { proc bgerror msg { global errorInfo errorCode x lappend x [list $msg $errorInfo $errorCode] @@ -162,18 +169,19 @@ test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} { after idle {set errorInfo foobar; set errorCode xyzzy} set x {} update idletasks + regsub -all [file join {} non_existent] $x "non_existent" +} -cleanup { rename bgerror {} - regsub -all [file join {} non_existent] $x "non_existent" x - set x -} {{{a simple error} {a simple error +} -result {{{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-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} { +test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} -setup { catch {rename bgerror {}} +} -body { proc bgerror msg { global x lappend x $msg @@ -183,9 +191,10 @@ test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} { after idle {open non_existent} set x {} update idletasks + return $x +} -cleanup { rename bgerror {} - set x -} {{a simple error}} +} -result {{a simple error}} test event-5.3 {HandleBgErrors: [Bug 1670155]} -setup { variable x proc demo args {variable x done} @@ -224,53 +233,60 @@ test event-5.8 {Default [interp bgerror] handler} -body { test event-5.9 {Default [interp bgerror] handler} -body { ::tcl::Bgerror {} {-level 0 -code ok} } -returnCodes error -match glob -result {*expected integer*} -test event-5.10 {Default [interp bgerror] handler} { +test event-5.10 {Default [interp bgerror] handler} -body { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror {} {-level 0 -code 0} + return $::res +} -cleanup { rename bgerror {} - set ::res -} {} -test event-5.11 {Default [interp bgerror] handler} { +} -result {} +test event-5.11 {Default [interp bgerror] handler} -body { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 1} + return $::res +} -cleanup { rename bgerror {} - set ::res -} {msg} -test event-5.12 {Default [interp bgerror] handler} { +} -result {msg} +test event-5.12 {Default [interp bgerror] handler} -body { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 2} + return $::res +} -cleanup { rename bgerror {} - set ::res -} {command returned bad code: 2} -test event-5.13 {Default [interp bgerror] handler} { +} -result {command returned bad code: 2} +test event-5.13 {Default [interp bgerror] handler} -body { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 3} + return $::res +} -cleanup { rename bgerror {} - set ::res -} {invoked "break" outside of a loop} -test event-5.14 {Default [interp bgerror] handler} { +} -result {invoked "break" outside of a loop} +test event-5.14 {Default [interp bgerror] handler} -body { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 4} + return $::res +} -cleanup { rename bgerror {} - set ::res -} {invoked "continue" outside of a loop} -test event-5.15 {Default [interp bgerror] handler} { +} -result {invoked "continue" outside of a loop} +test event-5.15 {Default [interp bgerror] handler} -body { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 5} + return $::res +} -cleanup { rename bgerror {} - set ::res -} {command returned bad code: 5} +} -result {command returned bad code: 5} -test event-6.1 {BgErrorDeleteProc procedure} { +test event-6.1 {BgErrorDeleteProc procedure} -setup { catch {interp delete foo} interp create foo set erroutfile [makeFile Unmodified err.out] +} -body { foo eval [list set erroutfile $erroutfile] foo eval { proc bgerror args { @@ -289,104 +305,99 @@ test event-6.1 {BgErrorDeleteProc procedure} { set f [open $erroutfile r] set result [read $f] close $f + return $result +} -cleanup { removeFile $erroutfile - set result -} {Unmodified +} -result {Unmodified } test event-7.1 {bgerror / regular} { set errRes {} proc bgerror {err} { - global errRes; - set errRes $err; + global errRes + set errRes $err } after 0 {error err1} - vwait errRes; - set errRes; + vwait errRes + return $errRes } err1 - test event-7.2 {bgerror / accumulation} { set errRes {} proc bgerror {err} { - global errRes; - lappend errRes $err; + global errRes + lappend errRes $err } after 0 {error err1} after 0 {error err2} after 0 {error err3} update - set errRes; + return $errRes } {err1 err2 err3} - test event-7.3 {bgerror / accumulation / break} { set errRes {} proc bgerror {err} { - global errRes; - lappend errRes $err; - return -code break "skip!"; + global errRes + lappend errRes $err + return -code break "skip!" } after 0 {error err1} after 0 {error err2} after 0 {error err3} update - set errRes; + return $errRes } err1 - -test event-7.4 {tkerror is nothing special anymore to tcl} { +test event-7.4 {tkerror is nothing special anymore to tcl} -body { set errRes {} # we don't just rename bgerror to empty because it could then # be autoloaded... proc bgerror {err} { - global errRes; - lappend errRes "bg:$err"; + global errRes + lappend errRes "bg:$err" } proc tkerror {err} { - global errRes; - lappend errRes "tk:$err"; + global errRes + lappend errRes "tk:$err" } after 0 {error err1} update + return $errRes +} -cleanup { rename tkerror {} - set errRes -} bg:err1 - -testConstraint exec [llength [info commands exec]] - -test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} {exec} { - set script { +} -result bg:err1 +test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} -body { + exec [interpreter] << { after 1000 error hello after 2000 set a 0 vwait a } - - list [catch {exec [interpreter] << $script} errMsg] $errMsg -} {1 {hello +} -constraints {exec} -returnCodes error -result {hello while executing "error hello" - ("after" script)}} - -test event-7.6 {safe hidden bgerror fallback} { + ("after" script)} +test event-7.6 {safe hidden bgerror fallback} -setup { variable result {} interp create -safe safe +} -body { safe alias puts puts safe alias result ::append [namespace which -variable result] safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}} safe hide bgerror safe eval after 0 error foo update + return $result +} -cleanup { interp delete safe - set result -} {foo +} -result {foo NONE foo while executing "error foo" ("after" script) } - -test event-7.7 {safe hidden bgerror fallback} { +test event-7.7 {safe hidden bgerror fallback} -setup { variable result {} interp create -safe safe +} -body { safe alias puts puts safe alias result ::append [namespace which -variable result] safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}} @@ -394,9 +405,10 @@ test event-7.7 {safe hidden bgerror fallback} { safe eval {proc bgerror m {error bar soom baz}} safe eval after 0 error foo update + return $result +} -cleanup { interp delete safe - set result -} {foo +} -result {foo NONE foo while executing @@ -404,18 +416,15 @@ foo ("after" script) } - -# someday : add a test checking that -# when there is no bgerror, an error msg goes to stderr -# ideally one would use sub interp and transfer a fake stderr -# to it, unfortunatly the current interp tcl API does not allow -# that. the other option would be to use fork a test but it -# then becomes more a file/exec test than a bgerror test. +# someday : add a test checking that when there is no bgerror, an error msg +# goes to stderr ideally one would use sub interp and transfer a fake stderr +# to it, unfortunatly the current interp tcl API does not allow that. The +# other option would be to use fork a test but it then becomes more a +# file/exec test than a bgerror test. # end of bgerror tests catch {rename bgerror {}} - test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] puts $child "testexithandler create 41; testexithandler create 4" @@ -423,7 +432,7 @@ test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} { flush $child set result [read $child] close $child - set result + return $result } {even 6 even 4 odd 41 @@ -437,7 +446,7 @@ test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { flush $child set result [read $child] close $child - set result + return $result } {even 16 even 6 even 4 @@ -450,8 +459,8 @@ test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { flush $child set result [read $child] close $child - set result - } {even 16 + return $result +} {even 16 even 6 odd 41 } @@ -463,7 +472,7 @@ test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { flush $child set result [read $child] close $child - set result + return $result } {even 16 even 4 odd 41 @@ -475,7 +484,7 @@ test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { flush $child set result [read $child] close $child - set result + return $result } {even 16 } @@ -486,22 +495,24 @@ test event-10.1 {Tcl_Exit procedure} {stdio} { [lindex $::errorCode 2] } {1 {child process exited abnormally} CHILDSTATUS 3} -test event-11.1 {Tcl_VwaitCmd procedure} { - list [catch {vwait} msg] $msg -} {1 {wrong # args: should be "vwait name"}} -test event-11.2 {Tcl_VwaitCmd procedure} { - list [catch {vwait a b} msg] $msg -} {1 {wrong # args: should be "vwait name"}} -test event-11.3 {Tcl_VwaitCmd procedure} { +test event-11.1 {Tcl_VwaitCmd procedure} -returnCodes error -body { + vwait +} -result {wrong # args: should be "vwait name"} +test event-11.2 {Tcl_VwaitCmd procedure} -returnCodes error -body { + vwait a b +} -result {wrong # args: should be "vwait name"} +test event-11.3 {Tcl_VwaitCmd procedure} -setup { catch {unset x} +} -body { set x 1 - list [catch {vwait x(1)} msg] $msg -} {1 {can't trace "x(1)": variable isn't array}} -test event-11.4 {Tcl_VwaitCmd procedure} {} { + vwait x(1) +} -returnCodes error -result {can't trace "x(1)": variable isn't array} +test event-11.4 {Tcl_VwaitCmd procedure} -setup { foreach i [after info] { after cancel $i } after 10; update; # On Mac make sure update won't take long +} -body { after 100 {set x x-done} after 200 {set y y-done} after 300 {set z z-done} @@ -511,22 +522,22 @@ test event-11.4 {Tcl_VwaitCmd procedure} {} { set z before set q before list [vwait y] $x $y $z $q -} {{} x-done y-done before q-done} - -foreach i [after info] { - after cancel $i -} - -test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} { +} -cleanup { + foreach i [after info] { + after cancel $i + } +} -result {{} x-done y-done before q-done} +test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} -setup { set test1file [makeFile "" test1] +} -constraints {socket} -body { set f1 [open $test1file w] proc accept {s args} { puts $s foobar close $s } - catch {set s1 [socket -server accept -myaddr 127.0.0.1 0]} + set s1 [socket -server accept -myaddr 127.0.0.1 0] after 1000 - catch {set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]} + set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]] close $s1 set x 0 set y 0 @@ -538,9 +549,10 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {soc vwait z close $f1 close $s2 - removeFile $test1file list $x $y $z -} {3 3 done} +} -cleanup { + removeFile $test1file +} -result {3 3 done} test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} { set test1file [makeFile "" test1] set test2file [makeFile "" test2] @@ -560,17 +572,17 @@ test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} { list $x $y $z } {3 3 done} - -test event-12.1 {Tcl_UpdateCmd procedure} { - list [catch {update a b} msg] $msg -} {1 {wrong # args: should be "update ?idletasks?"}} -test event-12.2 {Tcl_UpdateCmd procedure} { - list [catch {update bogus} msg] $msg -} {1 {bad option "bogus": must be idletasks}} -test event-12.3 {Tcl_UpdateCmd procedure} { +test event-12.1 {Tcl_UpdateCmd procedure} -returnCodes error -body { + update a b +} -result {wrong # args: should be "update ?idletasks?"} +test event-12.2 {Tcl_UpdateCmd procedure} -returnCodes error -body { + update bogus +} -result {bad option "bogus": must be idletasks} +test event-12.3 {Tcl_UpdateCmd procedure} -setup { foreach i [after info] { after cancel $i } +} -body { after 500 {set x after} after idle {set y after} after idle {set z "after, y = $y"} @@ -579,11 +591,16 @@ test event-12.3 {Tcl_UpdateCmd procedure} { set z before update idletasks list $x $y $z -} {before after {after, y = after}} -test event-12.4 {Tcl_UpdateCmd procedure} { +} -cleanup { foreach i [after info] { after cancel $i } +} -result {before after {after, y = after}} +test event-12.4 {Tcl_UpdateCmd procedure} -setup { + foreach i [after info] { + after cancel $i + } +} -body { after 10; update; # On Mac make sure update won't take long after 200 {set x x-done} after 600 {set y y-done} @@ -594,327 +611,311 @@ test event-12.4 {Tcl_UpdateCmd procedure} { after 300 update list $x $y $z -} {x-done before z-done} +} -cleanup { + foreach i [after info] { + after cancel $i + } +} -result {x-done before z-done} -test event-13.1 {Tcl_WaitForFile procedure, readable} {testfilehandler} { +test event-13.1 {Tcl_WaitForFile procedure, readable} -setup { foreach i [after info] { after cancel $i } - after 100 set x timeout testfilehandler close +} -constraints {testfilehandler} -body { + after 100 set x timeout 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-13.2 {Tcl_WaitForFile procedure, readable} testfilehandler { +} -cleanup { + testfilehandler close + foreach i [after info] { + after cancel $i + } +} -result {{} {no timeout}} +test event-13.2 {Tcl_WaitForFile procedure, readable} -setup { foreach i [after info] { after cancel $i } - after 100 set x timeout testfilehandler close +} -constraints testfilehandler -body { + after 100 set x timeout 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-13.3 {Tcl_WaitForFile procedure, readable} testfilehandler { +} -cleanup { + testfilehandler close + foreach i [after info] { + after cancel $i + } +} -result {{} timeout} +test event-13.3 {Tcl_WaitForFile procedure, readable} -setup { foreach i [after info] { after cancel $i } - after 100 set x timeout testfilehandler close +} -constraints testfilehandler -body { + after 100 set x timeout 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-13.4 {Tcl_WaitForFile procedure, writable} \ - {testfilehandler nonPortable} { +} -cleanup { + testfilehandler close + foreach i [after info] { + after cancel $i + } +} -result {readable {no timeout}} +test event-13.4 {Tcl_WaitForFile procedure, writable} -setup { foreach i [after info] { after cancel $i } - after 100 set x timeout testfilehandler close +} -constraints {testfilehandler nonPortable} -body { + after 100 set x timeout 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-13.5 {Tcl_WaitForFile procedure, writable} \ - {testfilehandler nonPortable} { +} -cleanup { + testfilehandler close + foreach i [after info] { + after cancel $i + } +} -result {{} {no timeout}} +test event-13.5 {Tcl_WaitForFile procedure, writable} -setup { foreach i [after info] { after cancel $i } - after 100 set x timeout testfilehandler close +} -constraints {testfilehandler nonPortable} -body { + after 100 set x timeout 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-13.6 {Tcl_WaitForFile procedure, writable} testfilehandler { +} -cleanup { + testfilehandler close + foreach i [after info] { + after cancel $i + } +} -result {{} timeout} +test event-13.6 {Tcl_WaitForFile procedure, writable} -setup { foreach i [after info] { after cancel $i } - after 100 set x timeout testfilehandler close +} -constraints testfilehandler -body { + after 100 set x timeout 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-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} testfilehandler { +} -cleanup { + testfilehandler close foreach i [after info] { after cancel $i } +} -result {writable {no timeout}} +test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} -setup { + foreach i [after info] { + after cancel $i + } + testfilehandler close +} -constraints testfilehandler -body { 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}} - +} -cleanup { + testfilehandler close + foreach i [after info] { + after cancel $i + } +} -result {{} {} {timeout idle}} test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} testfilewait { set f [open "|sleep 2" r] set result "" lappend result [testfilewait $f readable 100] lappend result [testfilewait $f readable -1] close $f - set result + return $result } {{} readable} - -test event-14.1 {Tcl_WaitForFile procedure, readable, big fd} \ - -constraints {testfilehandler unix} \ - -setup { - set chanList {} - for {set i 0} {$i < 32} {incr i} { - lappend chanList [open /dev/null r] - } - } \ - -body { - 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 - } \ - -result {{} {no timeout}} \ - -cleanup { - foreach chan $chanList {close $chan} +test event-14.1 {Tcl_WaitForFile procedure, readable, big fd} -setup { + set chanList {} + for {set i 0} {$i < 32} {incr i} { + lappend chanList [open /dev/null r] } - -test event-14.2 {Tcl_WaitForFile procedure, readable, big fd} \ - -constraints {testfilehandler unix} \ - -setup { - set chanList {} - for {set i 0} {$i < 32} {incr i} { - lappend chanList [open /dev/null r] - } - } \ - -body { - 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 - } \ - -result {{} timeout} \ - -cleanup { - foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} + testfilehandler close +} -constraints {testfilehandler unix} -body { + after 100 set x timeout + testfilehandler create 1 off off + set x "no timeout" + set result [testfilehandler wait 1 readable 0] + update + list $result $x +} -cleanup { + testfilehandler close + foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} +} -result {{} {no timeout}} +test event-14.2 {Tcl_WaitForFile procedure, readable, big fd} -setup { + set chanList {} + for {set i 0} {$i < 32} {incr i} { + lappend chanList [open /dev/null r] } - -test event-14.3 {Tcl_WaitForFile procedure, readable, big fd} \ - -constraints {testfilehandler unix} \ - -setup { - set chanList {} - for {set i 0} {$i < 32} {incr i} { - lappend chanList [open /dev/null r] - } - } \ - -body { - 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 - } \ - -result {readable {no timeout}} \ - -cleanup { - foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} + testfilehandler close +} -constraints {testfilehandler unix} -body { + after 100 set x timeout + testfilehandler create 1 off off + set x "no timeout" + set result [testfilehandler wait 1 readable 100] + update + list $result $x +} -cleanup { + testfilehandler close + foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} +} -result {{} timeout} +test event-14.3 {Tcl_WaitForFile procedure, readable, big fd} -setup { + set chanList {} + for {set i 0} {$i < 32} {incr i} { + lappend chanList [open /dev/null r] } - -test event-14.4 {Tcl_WaitForFile procedure, writable, big fd} \ - -constraints {testfilehandler unix nonPortable} \ - -setup { - set chanList {} - for {set i 0} {$i < 32} {incr i} { - lappend chanList [open /dev/null r] - } - } \ - -body { - 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 $ - } \ - -result {{} {no timeout}} \ - -cleanup { - foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} + testfilehandler close +} -constraints {testfilehandler unix} -body { + after 100 set x timeout + testfilehandler create 1 off off + testfilehandler fillpartial 1 + set x "no timeout" + set result [testfilehandler wait 1 readable 100] + update + list $result $x +} -cleanup { + testfilehandler close + foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} +} -result {readable {no timeout}} +test event-14.4 {Tcl_WaitForFile procedure, writable, big fd} -setup { + set chanList {} + for {set i 0} {$i < 32} {incr i} { + lappend chanList [open /dev/null r] } - -test event-14.5 {Tcl_WaitForFile procedure, writable, big fd} \ - -constraints {testfilehandler unix nonPortable} \ - -setup { - set chanList {} - for {set i 0} {$i < 32} {incr i} { - lappend chanList [open /dev/null r] - } - } \ - -body { - 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 - } \ - -result {{} timeout} \ - -cleanup { - foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} + testfilehandler close +} -constraints {testfilehandler unix nonPortable} -body { + after 100 set x timeout + testfilehandler create 1 off off + testfilehandler fill 1 + set x "no timeout" + set result [testfilehandler wait 1 writable 0] + update + list $result $x +} -cleanup { + testfilehandler close + foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} +} -result {{} {no timeout}} +test event-14.5 {Tcl_WaitForFile procedure, writable, big fd} -setup { + set chanList {} + for {set i 0} {$i < 32} {incr i} { + lappend chanList [open /dev/null r] } - -test event-14.6 {Tcl_WaitForFile procedure, writable, big fd} \ - -constraints {testfilehandler unix} \ - -setup { - set chanList {} - for {set i 0} {$i < 32} {incr i} { - lappend chanList [open /dev/null r] - } - } \ - -body { - 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 - } \ - -result {writable {no timeout}} \ - -cleanup { - foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} + testfilehandler close +} -constraints {testfilehandler unix nonPortable} -body { + after 100 set x timeout + testfilehandler create 1 off off + testfilehandler fill 1 + set x "no timeout" + set result [testfilehandler wait 1 writable 100] + update + list $result $x +} -cleanup { + testfilehandler close + foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} +} -result {{} timeout} +test event-14.6 {Tcl_WaitForFile procedure, writable, big fd} -setup { + set chanList {} + for {set i 0} {$i < 32} {incr i} { + lappend chanList [open /dev/null r] } - -test event-14.7 {Tcl_WaitForFile, don't call other event handlers, big fd} \ - -constraints {testfilehandler unix} \ - -setup { - set chanList {} - for {set i 0} {$i < 32} {incr i} { - lappend chanList [open /dev/null r] - } - } \ - -body { - 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 - } \ - -result {{} {} {timeout idle}} \ - -cleanup { - foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} + testfilehandler close +} -constraints {testfilehandler unix} -body { + after 100 set x timeout + testfilehandler create 1 off off + set x "no timeout" + set result [testfilehandler wait 1 writable 100] + update + list $result $x +} -cleanup { + testfilehandler close + foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} +} -result {writable {no timeout}} +test event-14.7 {Tcl_WaitForFile, don't call other event handlers, big fd} -setup { + set chanList {} + for {set i 0} {$i < 32} {incr i} { + lappend chanList [open /dev/null r] } - - -test event-14.8 {Tcl_WaitForFile procedure, waiting indefinitely, big fd} \ - -constraints {testfilewait unix} \ - -body { - set f [open "|sleep 2" r] - set result "" - lappend result [testfilewait $f readable 100] - lappend result [testfilewait $f readable -1] - close $f - set result - } \ - -setup { - set chanList {} - for {set i 0} {$i < 32} {incr i} { - lappend chanList [open /dev/null r] - } - } \ - -result {{} readable} \ - -cleanup { - foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} + testfilehandler close +} -constraints {testfilehandler unix} -body { + after 100 lappend x timeout + after idle lappend x idle + testfilehandler create 1 off off + set x "" + set result [list [testfilehandler wait 1 readable 200] $x] + update + lappend result $x +} -cleanup { + testfilehandler close + foreach chan $chanList {close $chan} + foreach i [after info] {after cancel $i} +} -result {{} {} {timeout idle}} +test event-14.8 {Tcl_WaitForFile procedure, waiting indefinitely, big fd} -setup { + set chanList {} + for {set i 0} {$i < 32} {incr i} { + lappend chanList [open /dev/null r] } - +} -constraints {testfilewait unix} -body { + set f [open "|sleep 2" r] + set result "" + lappend result [testfilewait $f readable 100] + lappend result [testfilewait $f readable -1] + close $f + return $result +} -cleanup { + foreach chan $chanList {close $chan} +} -result {{} readable} + # cleanup foreach i [after info] { after cancel $i } ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: |