diff options
Diffstat (limited to 'tests/event.test')
| -rw-r--r-- | tests/event.test | 814 |
1 files changed, 387 insertions, 427 deletions
diff --git a/tests/event.test b/tests/event.test index d62d08e..a7122f9 100644 --- a/tests/event.test +++ b/tests/event.test @@ -1,56 +1,44 @@ # 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 © 1995-1997 Sun Microsystems, Inc. -# Copyright © 1998-1999 Scriptics Corporation. +# Copyright (c) 1995-1997 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. -package require tcltest 2.5 +package require tcltest 2 namespace import -force ::tcltest::* -catch { - ::tcltest::loadTestedCommands - package require -exact tcl::test [info patchlevel] - set ::tcltestlib [info loaded {} Tcltest] -} - - testConstraint testfilehandler [llength [info commands testfilehandler]] testConstraint testexithandler [llength [info commands testexithandler]] testConstraint testfilewait [llength [info commands testfilewait]] -testConstraint exec [llength [info commands exec]] -testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}] -test event-1.1 {Tcl_CreateFileHandler, reading} -setup { +test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler} { testfilehandler close - set result "" -} -constraints {testfilehandler notOSX} -body { testfilehandler create 0 readable off testfilehandler clear 0 testfilehandler oneevent + set result "" lappend result [testfilehandler counts 0] testfilehandler fillpartial 0 - update idletasks testfilehandler oneevent lappend result [testfilehandler counts 0] testfilehandler oneevent lappend result [testfilehandler counts 0] -} -cleanup { testfilehandler close -} -result {{0 0} {1 0} {2 0}} -test event-1.2 {Tcl_CreateFileHandler, writing} -setup { + 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. 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 @@ -58,17 +46,16 @@ test event-1.2 {Tcl_CreateFileHandler, writing} -setup { testfilehandler fill 0 testfilehandler oneevent lappend result [testfilehandler counts 0] -} -cleanup { testfilehandler close -} -result {{0 1} {0 2} {0 2}} -test event-1.3 {Tcl_DeleteFileHandler} -setup { + set result +} {{0 1} {0 2} {0 2}} +test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} { 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 @@ -78,17 +65,16 @@ test event-1.3 {Tcl_DeleteFileHandler} -setup { testfilehandler create 1 off off testfilehandler oneevent lappend result [testfilehandler counts 1] -} -cleanup { testfilehandler close -} -result {{0 1} {1 1} {1 2} {0 0}} + set result +} {{0 1} {1 1} {1 2} {0 0}} -test event-2.1 {Tcl_DeleteFileHandler} -setup { +test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} { 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 @@ -98,44 +84,43 @@ test event-2.1 {Tcl_DeleteFileHandler} -setup { testfilehandler create 1 off off testfilehandler oneevent lappend result [testfilehandler counts 1] -} -cleanup { testfilehandler close -} -result {{0 1} {1 1} {1 2} {0 0}} -test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} -setup { + set result +} {{0 1} {1 1} {1 2} {0 0}} +test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} \ + {testfilehandler nonPortable} { 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 -} -result {{0 1} {0 0}} + set result +} {{0 1} {0 0}} -test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off} -setup { +test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {testfilehandler} { testfilehandler close -} -constraints {testfilehandler} -body { testfilehandler create 1 readable writable testfilehandler fillpartial 1 testfilehandler windowevent - testfilehandler counts 1 -} -cleanup { + set result [testfilehandler counts 1] testfilehandler close -} -result {0 0} + set result +} {0 0} -test event-4.1 {FileHandlerEventProc, race between event and disabling} -setup { +test event-4.1 {FileHandlerEventProc, race between event and disabling} \ + {testfilehandler nonPortable} { 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 @@ -145,13 +130,13 @@ test event-4.1 {FileHandlerEventProc, race between event and disabling} -setup { testfilehandler create 1 disabled disabled testfilehandler oneevent lappend result [testfilehandler counts 1] -} -cleanup { testfilehandler close -} -result {{0 1} {1 1} {1 2} {0 0}} -test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} -setup { + set result +} {{0 1} {1 1} {1 2} {0 0}} +test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \ + {testfilehandler nonPortable} { update testfilehandler close -} -constraints {testfilehandler nonPortable} -body { testfilehandler create 1 readable writable testfilehandler create 2 readable writable testfilehandler fillpartial 1 @@ -161,14 +146,13 @@ test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} -setup { lappend result [testfilehandler counts 1] [testfilehandler counts 2] testfilehandler windowevent lappend result [testfilehandler counts 1] [testfilehandler counts 2] -} -cleanup { testfilehandler close -} -result {{0 0} {0 1} {0 0} {0 1}} + set result +} {{0 0} {0 1} {0 0} {0 1}} update -test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} -setup { +test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} { catch {rename bgerror {}} -} -body { proc bgerror msg { global errorInfo errorCode x lappend x [list $msg $errorInfo $errorCode] @@ -178,19 +162,18 @@ test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} -setup { after idle {set errorInfo foobar; set errorCode xyzzy} set x {} update idletasks - regsub -all [file join {} non_existent] $x "non_existent" -} -cleanup { rename bgerror {} -} -result {{{a simple error} {a simple error + regsub -all [file join {} non_existent] $x "non_existent" x + 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-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} -setup { +test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} { catch {rename bgerror {}} -} -body { proc bgerror msg { global x lappend x $msg @@ -200,10 +183,9 @@ test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} -setup { after idle {open non_existent} set x {} update idletasks - return $x -} -cleanup { rename bgerror {} -} -result {{a simple error}} + set x +} {{a simple error}} test event-5.3 {HandleBgErrors: [Bug 1670155]} -setup { variable x proc demo args {variable x done} @@ -242,60 +224,53 @@ 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} -body { +test event-5.10 {Default [interp bgerror] handler} { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror {} {-level 0 -code 0} - return $::res -} -cleanup { rename bgerror {} -} -result {} -test event-5.11 {Default [interp bgerror] handler} -body { + set ::res +} {} +test event-5.11 {Default [interp bgerror] handler} { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 1} - return $::res -} -cleanup { rename bgerror {} -} -result {msg} -test event-5.12 {Default [interp bgerror] handler} -body { + set ::res +} {msg} +test event-5.12 {Default [interp bgerror] handler} { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 2} - return $::res -} -cleanup { rename bgerror {} -} -result {command returned bad code: 2} -test event-5.13 {Default [interp bgerror] handler} -body { + set ::res +} {command returned bad code: 2} +test event-5.13 {Default [interp bgerror] handler} { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 3} - return $::res -} -cleanup { rename bgerror {} -} -result {invoked "break" outside of a loop} -test event-5.14 {Default [interp bgerror] handler} -body { + set ::res +} {invoked "break" outside of a loop} +test event-5.14 {Default [interp bgerror] handler} { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 4} - return $::res -} -cleanup { rename bgerror {} -} -result {invoked "continue" outside of a loop} -test event-5.15 {Default [interp bgerror] handler} -body { + set ::res +} {invoked "continue" outside of a loop} +test event-5.15 {Default [interp bgerror] handler} { proc bgerror {m} {append ::res $m} set ::res {} ::tcl::Bgerror msg {-level 0 -code 5} - return $::res -} -cleanup { rename bgerror {} -} -result {command returned bad code: 5} + set ::res +} {command returned bad code: 5} -test event-6.1 {BgErrorDeleteProc procedure} -setup { +test event-6.1 {BgErrorDeleteProc procedure} { 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 { @@ -314,99 +289,104 @@ test event-6.1 {BgErrorDeleteProc procedure} -setup { set f [open $erroutfile r] set result [read $f] close $f - return $result -} -cleanup { removeFile $erroutfile -} -result {Unmodified + set 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 - return $errRes + vwait errRes; + set 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 - return $errRes + set 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 - return $errRes + set errRes; } err1 -test event-7.4 {tkerror is nothing special anymore to tcl} -body { + +test event-7.4 {tkerror is nothing special anymore to tcl} { 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 {} -} -result bg:err1 -test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} -body { - exec [interpreter] << { + 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 { after 1000 error hello after 2000 set a 0 vwait a } -} -constraints {exec} -returnCodes error -result {hello + + list [catch {exec [interpreter] << $script} errMsg] $errMsg +} {1 {hello while executing "error hello" - ("after" script)} -test event-7.6 {safe hidden bgerror fallback} -setup { + ("after" script)}} + +test event-7.6 {safe hidden bgerror fallback} { 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 -} -result {foo + set result +} {foo NONE foo while executing "error foo" ("after" script) } -test event-7.7 {safe hidden bgerror fallback} -setup { + +test event-7.7 {safe hidden bgerror fallback} { 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}} @@ -414,10 +394,9 @@ test event-7.7 {safe hidden bgerror fallback} -setup { safe eval {proc bgerror m {error bar soom baz}} safe eval after 0 error foo update - return $result -} -cleanup { interp delete safe -} -result {foo + set result +} {foo NONE foo while executing @@ -425,24 +404,26 @@ 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, unfortunately 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 "catch {load $::tcltestlib Tcltest}" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; exit" flush $child set result [read $child] close $child - return $result + set result } {even 6 even 4 odd 41 @@ -450,55 +431,51 @@ odd 41 test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] - puts $child "catch {load $::tcltestlib Tcltest}" 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 - return $result + set result } {even 16 even 6 even 4 } test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] - puts $child "catch {load $::tcltestlib Tcltest}" 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 - return $result -} {even 16 + set result + } {even 16 even 6 odd 41 } test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] - puts $child "catch {load $::tcltestlib Tcltest}" 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 - return $result + set result } {even 16 even 4 odd 41 } test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] - puts $child "catch {load $::tcltestlib Tcltest}" puts $child "testexithandler create 41; testexithandler delete 41" puts $child "testexithandler create 16; exit" flush $child set result [read $child] close $child - return $result + set result } {even 16 } @@ -509,46 +486,47 @@ 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} -body { - vwait -} -result {} -test event-11.3 {Tcl_VwaitCmd procedure} -setup { +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} { catch {unset x} -} -body { set x 1 - vwait x(1) -} -returnCodes error -result {can't trace "x(1)": variable isn't array} -test event-11.4 {Tcl_VwaitCmd procedure} -setup { + list [catch {vwait x(1)} msg] $msg +} {1 {can't trace "x(1)": variable isn't array}} +test event-11.4 {Tcl_VwaitCmd procedure} {} { 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 400 {set z z-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 -} -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 { +} {{} 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} { set test1file [makeFile "" test1] -} -constraints {socket} -body { set f1 [open $test1file w] proc accept {s args} { puts $s foobar close $s } - set s1 [socket -server accept -myaddr 127.0.0.1 0] + catch {set s1 [socket -server accept -myaddr 127.0.0.1 0]} after 1000 - set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]] + catch {set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]} close $s1 set x 0 set y 0 @@ -560,10 +538,9 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} -set vwait z close $f1 close $s2 - list $x $y $z -} -cleanup { removeFile $test1file -} -result {3 3 done} + list $x $y $z +} {3 3 done} test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} { set test1file [makeFile "" test1] set test2file [makeFile "" test2] @@ -582,46 +559,18 @@ test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} { removeFile $test2file list $x $y $z } {3 3 done} -test event-11.7 {Bug 16828b3744} { - after idle { - set ::t::v 1 - namespace delete ::t - } - namespace eval ::t { - vwait ::t::v - } -} {} -test event-11.8 {Bug 16828b3744} -setup { - oo::class create A { - variable continue - method start {} { - after idle [self] destroy - set continue 0 - vwait [namespace current]::continue - } - destructor { - set continue 1 - } - } -} -body { - [A new] start -} -cleanup { - A destroy -} -result {} - -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 { +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} { 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"} @@ -630,16 +579,11 @@ test event-12.3 {Tcl_UpdateCmd procedure} -setup { set z before update idletasks list $x $y $z -} -cleanup { +} {before after {after, y = after}} +test event-12.4 {Tcl_UpdateCmd procedure} { 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} @@ -650,311 +594,327 @@ test event-12.4 {Tcl_UpdateCmd procedure} -setup { after 300 update list $x $y $z -} -cleanup { - foreach i [after info] { - after cancel $i - } -} -result {x-done before z-done} +} {x-done before z-done} -test event-13.1 {Tcl_WaitForFile procedure, readable} -setup { +test event-13.1 {Tcl_WaitForFile procedure, readable} {testfilehandler} { foreach i [after info] { after cancel $i } - testfilehandler close -} -constraints {testfilehandler} -body { after 100 set x timeout + testfilehandler close testfilehandler create 1 off off set x "no timeout" set result [testfilehandler wait 1 readable 0] update - list $result $x -} -cleanup { testfilehandler close + list $result $x +} {{} {no timeout}} +test event-13.2 {Tcl_WaitForFile procedure, readable} testfilehandler { 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 - } - testfilehandler close -} -constraints testfilehandler -body { after 100 set x timeout + testfilehandler close testfilehandler create 1 off off set x "no timeout" set result [testfilehandler wait 1 readable 100] update - list $result $x -} -cleanup { testfilehandler close + list $result $x +} {{} timeout} +test event-13.3 {Tcl_WaitForFile procedure, readable} testfilehandler { 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 - } - testfilehandler close -} -constraints testfilehandler -body { 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 - list $result $x -} -cleanup { testfilehandler close + list $result $x +} {readable {no timeout}} +test event-13.4 {Tcl_WaitForFile procedure, writable} \ + {testfilehandler nonPortable} { 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 - } - testfilehandler close -} -constraints {testfilehandler nonPortable} -body { 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 - list $result $x -} -cleanup { testfilehandler close + list $result $x +} {{} {no timeout}} +test event-13.5 {Tcl_WaitForFile procedure, writable} \ + {testfilehandler nonPortable} { 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 - } - testfilehandler close -} -constraints {testfilehandler nonPortable} -body { 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 - list $result $x -} -cleanup { testfilehandler close + list $result $x +} {{} timeout} +test event-13.6 {Tcl_WaitForFile procedure, writable} testfilehandler { 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 - } - testfilehandler close -} -constraints testfilehandler -body { after 100 set x timeout + testfilehandler close testfilehandler create 1 off off set x "no timeout" set result [testfilehandler wait 1 writable 100] update - list $result $x -} -cleanup { testfilehandler close + list $result $x +} {writable {no timeout}} +test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} testfilehandler { 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 - lappend result $x -} -cleanup { testfilehandler close - foreach i [after info] { - after cancel $i - } -} -result {{} {} {timeout idle}} + lappend result $x +} {{} {} {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 - return $result + set result } {{} readable} -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.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} } - 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.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 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.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 - 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.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 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.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 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.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} -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.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 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] + + +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} } -} -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: |