summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2006-11-28 16:29:47 (GMT)
committerKevin B Kenny <kennykb@acm.org>2006-11-28 16:29:47 (GMT)
commit78afab8ec5cb163b94f8fed86fb67d9e339d9268 (patch)
tree2a4153277da51a6fe37fa2b23a1c880874e8872f
parent6da4a8974f27a03af1fd2ef3ded24be102f381bd (diff)
downloadtcl-78afab8ec5cb163b94f8fed86fb67d9e339d9268.zip
tcl-78afab8ec5cb163b94f8fed86fb67d9e339d9268.tar.gz
tcl-78afab8ec5cb163b94f8fed86fb67d9e339d9268.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].
-rw-r--r--ChangeLog8
-rw-r--r--tests/event.test211
-rw-r--r--unix/tclUnixChan.c7
3 files changed, 222 insertions, 4 deletions
diff --git a/ChangeLog b/ChangeLog
index 9e7a5cb..53c91d6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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