"thread blocked indefinitely" exception while blocking on a socket
First start a TCP server, e.g. nc.
% nc localhost -l 1234 > /dev/null
On another shell, compile the following program and run it:
% ghc -threaded sock.hs
% ./sock localhost 1234
receiver: thread blocked indefinitely in an MVar operation
{-# LANGUAGE ViewPatterns #-}
import Control.Applicative -- GHC 7.8 compatibility
import Control.Concurrent
import qualified Control.Exception as Ex
import Control.Monad
import qualified Data.ByteString.Char8 as S
import Network.Socket
import qualified Network.Socket.ByteString as Sock
import Network.BSD (getHostByName, hostAddresses)
import System.Environment
import System.Mem
main :: IO ()
main = do
[host, read -> fromInteger -> port] <- getArgs
sock <- connectTo host port
forkVerbose "sender" $ forever $ do
_ <- Sock.send sock $ S.replicate 40000 '0'
return ()
forkVerbose "receiver" $ forever $ do
dat <- Sock.recv sock 2048
putStrLn $ "received: " ++ show dat
forever $ do
threadDelay 1000000
performGC
forkVerbose :: String -> IO () -> IO ()
forkVerbose name act = void $ forkIO $ do act; msg "exiting normally"
`Ex.catch` \e -> msg $ show (e :: Ex.SomeException)
where
msg s = putStrLn $ name ++ ": " ++ s
connectTo :: HostName -> PortNumber -> IO Socket
connectTo hostName port = do
addr <- SockAddrInet port <$> lookupHost hostName
sock <- socket AF_INET Stream 0
connect sock addr
return sock
lookupHost :: String -> IO HostAddress
lookupHost name = do
hostInfo <- getHostByName name
case hostAddresses hostInfo of
[] -> error ("Invalid host name: " ++ name)
(a:_) -> return a
GHC 7.8.3 doesn't have this problem.
I suspect that this is a regression in the event manager. When there is an event, GHC.Event.Manager.onFdEvent
seems to remove all callbacks associated to the fd
, whether or not they match the current event. In the program above, the callback for recv
may be removed permanently when the socket becomes ready for send
ing, causing the "receiver" thread to deadlock.
Trac metadata
Trac field | Value |
---|---|
Version | 7.10.1 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | libraries/base |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | ekmett, hvr |
Operating system | |
Architecture |