diff options
author | Kevin B Kenny <kennykb@acm.org> | 2006-11-27 20:16:02 (GMT) |
---|---|---|
committer | Kevin B Kenny <kennykb@acm.org> | 2006-11-27 20:16:02 (GMT) |
commit | 560ef2959a601d2e63d900821bc0946392be40c6 (patch) | |
tree | 7ecf464ae3646a2382ad3ca291c8397797a4a018 /tests | |
parent | d8d2992ff2e190e6b68d55ae255aaea89183265b (diff) | |
download | tcl-560ef2959a601d2e63d900821bc0946392be40c6.zip tcl-560ef2959a601d2e63d900821bc0946392be40c6.tar.gz tcl-560ef2959a601d2e63d900821bc0946392be40c6.tar.bz2 |
* unix/tclUnixChan.c (TclUnixWaitForFile):
* tests/event.test (event-14.*): Corrected a bug where
TclUnixWaitForFile would present select() with the wrong mask
on an LP64 machine if a fd number exceeds 32. Thanks to
Jean-Luc Fontaine for reporting and diagnosing [Bug 1602208].
Diffstat (limited to 'tests')
-rw-r--r-- | tests/event.test | 211 |
1 files changed, 210 insertions, 1 deletions
diff --git a/tests/event.test b/tests/event.test index 0ac11cd..e2553d6 100644 --- a/tests/event.test +++ b/tests/event.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: event.test,v 1.22 2006/11/03 11:45:33 dkf Exp $ +# RCS: @(#) $Id: event.test,v 1.23 2006/11/27 20:16:03 kennykb Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -586,6 +586,215 @@ test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} testfilewait { set 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.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} + } + +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} + } + +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} + } + +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} + } + +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} + } + +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} + } + + +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} + } + # cleanup foreach i [after info] { after cancel $i |