IO manager can deadlock if a file descriptor is closed behind its back

Consider the following simple "echo server":

module Main where

import Control.Concurrent
import Network
import System.IO
import System.Timeout

main :: IO ()
main = do
    s <- listenOn (Service "7000")
    loop s
    return ()
    
loop :: Socket -> IO ThreadId
loop s = do
    (hdr,_,_) <- accept s
    hSetBuffering hdr LineBuffering
    forkIO $ echo hdr
    loop s
    
echo :: Handle -> IO ()
echo hdr = do
    mstr <- timeout 5000000 $ hGetLine hdr
    case mstr of
        Just str -> do
            hPutStrLn hdr str
            hFlush hdr
            echo hdr
        Nothing -> do
            putStrLn "Time out"
            hClose hdr
            return ()

When compiled without -threaded (GHC 7.0.1) it behaves as expected: you could "telnet localhost 7000", send a couple of lines, see them echoed back and if you don't type anything for 5 seconds, connection will be closed. If you connect for the second (third, ...) time, behavior will be the same.

Now, recompile the code with -threaded. On the first connect, everything would be as expected. However, after the first time out, when you "telnet" for the second time, behavior will be different.

1)Your lines would not be echoed back to you 2)Your connection would time out 5 seconds after you connected, no matter if you type and send something or not

See this video (OGV, 1.5mb) for demonstration of behavior with -threaded.

GHC 6.12.3 behaves correctly with -threaded and without, so I guess that new IO manager contributes to this situation.

This bug is confirmed to be present on Linux and MacOS X.

Trac metadata

Trac field	Value
Version	7.0.1
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Runtime System
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system	Unknown/Multiple
Architecture