diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | tests/event.test | 211 | ||||
| -rw-r--r-- | unix/tclUnixChan.c | 7 |
3 files changed, 222 insertions, 4 deletions
@@ -1,3 +1,11 @@ +2006-11-27 Kevin Kenny <kennykb@acm.org> + + * 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]. + 2006-11-26 Daniel Steffen <das@users.sourceforge.net> * tcl.m4 (Linux): --enable-64bit support. [Patch 1597389], [Bug 1230558] diff --git a/tests/event.test b/tests/event.test index 0cf627b..98e660d 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.20 2002/07/10 11:56:44 dgp Exp $ +# RCS: @(#) $Id: event.test,v 1.20.2.1 2006/11/28 16:29:47 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 diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 0d2c046..5c4cb65 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixChan.c,v 1.42.2.9 2006/09/07 08:50:35 vasiljevic Exp $ + * RCS: @(#) $Id: tclUnixChan.c,v 1.42.2.10 2006/11/28 16:29:48 kennykb Exp $ */ #include "tclInt.h" /* Internal definitions for Tcl. */ @@ -3185,7 +3185,8 @@ TclUnixWaitForFile(fd, mask, timeout) { Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */ struct timeval blockTime, *timeoutPtr; - int index, bit, numFound, result = 0; + int index, numFound, result = 0; + fd_mask bit; fd_mask readyMasks[3*MASK_SIZE]; /* This array reflects the readable/writable * conditions that were found to exist by the @@ -3222,7 +3223,7 @@ TclUnixWaitForFile(fd, mask, timeout) } memset((VOID *) readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask)); index = fd/(NBBY*sizeof(fd_mask)); - bit = 1 << (fd%(NBBY*sizeof(fd_mask))); + bit = ((fd_mask) 1) << (fd%(NBBY*sizeof(fd_mask))); /* * Loop in a mini-event loop of our own, waiting for either the |