[GHC] #10629: threadWaitRead throws BlockedIndefinitelyOnMVar

[GHC]

#10629: threadWaitRead throws BlockedIndefinitelyOnMVar
-------------------------------------+-------------------------------------
        Reporter:                    |                   Owner:  simonmar
  facundo.dominguez                  |
            Type:  bug               |                  Status:  new
        Priority:  normal            |               Milestone:
       Component:  Runtime System    |                 Version:  7.10.1
      Resolution:                    |                Keywords:
                                     |  concurrency sockets
Operating System:  Linux             |            Architecture:
 Type of failure:  Incorrect result  |  Unknown/Multiple
  at runtime                         |               Test Case:
      Blocked By:                    |                Blocking:
 Related Tickets:                    |  Differential Revisions:
-------------------------------------+-------------------------------------

Comment (by facundo.dominguez):

 After staring a while to the code in {{{GHC.Event}}}, I got this program
 which seems to reproduce the problem. I'm using {{{network-2.6.2.1}}},
 though I don't think the particular version makes a difference.

 {{{
 -- t.hs
 --
 -- The output should look like
 --
 -- > $ ghc --make -threaded t.hs
 -- > $ ./t
 -- > threadWaitWrite: terminated
 -- > threadWaitRead: thread blocked indefinitely in an MVar operation
 -- > threadWaitRead: terminated
 -- > main thread terminated
 --
 main thread terminated

 import Control.Concurrent
 import Control.Exception
 import Control.Monad
 import System.IO
 import System.Mem
 import Network.Socket

 main :: IO ()
 main = do
     (s0, s1) <- socketPair AF_UNIX Stream defaultProtocol
     let fd = fdSocket s0
     forkIO $ do
       catch (threadWaitRead (fromIntegral fd)) $ \e ->
         putStrLn $ "threadWaitRead: " ++ show (e :: SomeException)
       putStrLn "threadWaitRead: terminated"
     forkIO $ do
       threadDelay 500000
       catch (threadWaitWrite (fromIntegral fd)) $ \e ->
         putStrLn $ "threadWaitWrite: " ++ show (e :: SomeException)
       putStrLn "threadWaitWrite: terminated"
     threadDelay 1000000
     send s1 "hello"
     putStrLn "main thread terminated"
 }}}

 {{{GHC.Event.Manager}}} has a suspicious
 [https://github.com/ghc/ghc/blob/ghc-7.10.1-release/libraries/base/GHC/Event/Manager.hs#L459
 line]. It removes all callbacks from the table, but I can't see where the
 unmatched callbacks are added back.

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