Skip to content

GitLab

  • Projects
  • Groups
  • Snippets
  • Help
    • Loading...
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
GHC
GHC
  • Project overview
    • Project overview
    • Details
    • Activity
    • Releases
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 4,390
    • Issues 4,390
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 373
    • Merge Requests 373
  • Requirements
    • Requirements
    • List
  • CI / CD
    • CI / CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Operations
    • Operations
    • Incidents
    • Environments
  • Analytics
    • Analytics
    • CI / CD
    • Code Review
    • Insights
    • Issue
    • Repository
    • Value Stream
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Members
    • Members
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #5553

Closed
Open
Opened Oct 12, 2011 by bit@trac-bit

sendWakeup error in simple test program with MVars and killThread

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
Trac metadata
Trac field Value
Version 7.2.1
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Runtime System
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture
Assignee
Assign to
8.2.2
Milestone
8.2.2 (Past due)
Assign milestone
Time tracking
None
Due date
None
Reference: ghc/ghc#5553