[GHC] #14530: hWaitForInput causes the program to abort on Windows

[GHC]

#14530: hWaitForInput causes the program to abort on Windows
-----------------------------------+--------------------------------------
        Reporter:  dnadales        |                Owner:  (none)
            Type:  bug             |               Status:  new
        Priority:  normal          |            Milestone:
       Component:  Core Libraries  |              Version:  8.0.2
      Resolution:                  |             Keywords:
Operating System:  Windows         |         Architecture:  x86_64 (amd64)
 Type of failure:  Runtime crash   |            Test Case:
      Blocked By:                  |             Blocking:
 Related Tickets:                  |  Differential Rev(s):
       Wiki Page:                  |
-----------------------------------+--------------------------------------
Description changed by dnadales:

Old description:

> When running the following program on Windows (10):
>
> {{{#!hs
> readWithinNSecs :: IO ()
> readWithinNSecs = withSocketsDo $ do
>   h <- connectTo "localhost" (PortNumber 9090)
>   hSetBuffering h NoBuffering
>   readerTid <- forkIO $ politeReader h
>   threadDelay (2 * 10^6)
>   killThread readerTid
>
>   where
>     politeReader h = do
>       info <- hShow h
>       putStrLn info
>       line <- ifM (hWaitForInput h (10^6)) (hGetLine h) (return
> "Nothing!")
>       putStrLn $ "Got " ++ line
> }}}
>
> The program aborts with the following error:
>
> {{{#!text
> {loc=<socket: 380>,type=duplex (read-write),buffering=none}
> fdReady: fd is too big
> This application has requested the Runtime to terminate it in an unusual
> way.
> }}}

New description:

 When running the "server" and "client" progams shown below, the client
 aborts, on Windows (10), with the following error:

 {{{#!text
 {loc=<socket: 380>,type=duplex (read-write),buffering=none}
 fdReady: fd is too big
 This application has requested the Runtime to terminate it in an unusual
 way.
 }}}

 Here is the code for the client:

 {{{#!hs

 import Network
 import Control.Concurrent
 import System.IO

 main = readWithinNSecs

 readWithinNSecs :: IO ()
 readWithinNSecs = withSocketsDo $ do
   h <- connectTo "localhost" (PortNumber 9090)
   hSetBuffering h NoBuffering
   readerTid <- forkIO $ politeReader h
   threadDelay (2 * 10^6)
   killThread readerTid

   where
     politeReader h = do
       info <- hShow h
       putStrLn info
       gotSth <- hWaitForInput h (10^6)
       if gotSth
         then do
             line <- hGetLine h
             putStrLn $ "Got " ++ line
         else
             return ()

 }}}

 And here the code for the server:

 {{{#!hs

 module Main where

 import Network.Socket
 import Control.Concurrent

 main :: IO ()
 main = do
     sock <- socket AF_INET Stream 0    -- create socket
     setSocketOption sock ReuseAddr 1   -- make socket immediately reusable
 - eases debugging.
     bind sock (SockAddrInet 9090 iNADDR_ANY)   -- listen on TCP port 4242.
     listen sock 2                              -- set a max of 2 queued
 connections
     mainLoop sock

 mainLoop :: Socket -> IO ()
 mainLoop sock = do
     conn <- accept sock     -- accept a connection and handle it
     runConn conn            -- run our server's logic
     mainLoop sock           -- repeat

 runConn :: (Socket, SockAddr) -> IO ()
 runConn (sock, _) = do
     threadDelay (2 * 10^6)
     send sock "Hello!\n"
     close sock

 }}}

--

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14530#comment:2>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler