summaryrefslogtreecommitdiffstats
path: root/tests/event.test
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2006-11-27 20:16:02 (GMT)
committerKevin B Kenny <kennykb@acm.org>2006-11-27 20:16:02 (GMT)
commit560ef2959a601d2e63d900821bc0946392be40c6 (patch)
tree7ecf464ae3646a2382ad3ca291c8397797a4a018 /tests/event.test
parentd8d2992ff2e190e6b68d55ae255aaea89183265b (diff)
downloadtcl-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/event.test')
-rw-r--r--tests/event.test211
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