The following test program causes a sendWakeup error to be printed. It happens rarely, not on every run of the program.

I'm running GHC 7.2.1 on a fairly old Linux 2.6.27 system.

Running it from the shell in a loop should cause it to eventually display the error message. I found that by causing CPU activity (such as running "yes" in another terminal) while the shell loop below is running triggers the error.

$ ghc --make -Wall -O -threaded -rtsopts ghc_sendWakeup_bug.hs
$ while [ 1 ]; do ./ghc_sendWakeup_bug 40; done
ghc_sendWakeup_bug: sendWakeup: invalid argument (Bad file descriptor)

ghc_sendWakeup_bug.hs

module Main
    ( startTest
    , main
    ) where

import Control.Concurrent (ThreadId, forkIO, killThread, threadDelay)
import Control.Concurrent.MVar
import Control.Exception (finally, catch, SomeException, mask_)
import Control.Monad (when, replicateM_, forever)
import Prelude hiding (catch)
import System.Environment (getArgs, getProgName)
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)

startClient :: IO ()
startClient = threadDelay (1000 * 10)

startTest :: Int -> IO ()
startTest numClients = do
    -- Code adapted from:
    -- http://hackage.haskell.org/packages/archive/base/4.4.0.0/doc/html/Control-Concurrent.html#g:12
    children <- newMVar [] :: IO (MVar [MVar ()])

    let forkChild :: IO () -> IO ThreadId
        forkChild io = do
            mvar <- newEmptyMVar
            mask_ $ do
                modifyMVar_ children (return . (mvar:))
                forkIO (io `finally` putMVar mvar ())
        waitForChildren :: IO ()
        waitForChildren = do
            cs <- takeMVar children
            case cs of
                [] -> return ()
                m:ms -> do
                    putMVar children ms
                    takeMVar m
                    waitForChildren

    serverThread <- forkIO $ forever (threadDelay 1000000)

    replicateM_ numClients (forkChild startClient)
    catch waitForChildren (printException "waitForChildren")
    catch (killThread serverThread) (printException "killThread")

printException :: String -> SomeException -> IO ()
printException place ex =
    hPutStrLn stderr $ "Error in " ++ place ++ ": " ++ show ex

main :: IO ()
main = do
    args <- getArgs
    when (length args /= 1) $ do
        prog <- getProgName
        hPutStrLn stderr $ "Usage: " ++ prog ++ " <numClients>"
        exitFailure
    let numClients = read (args !! 0)
    startTest numClients