libraries/base/tests/Concurrent/Chan002.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

import Control.Concurrent
import Control.Exception
import Control.Monad
import System.IO
import System.Environment

-- test for deadlocks
main = do
  hSetBuffering stdout NoBuffering
  [n] <- getArgs
  replicateM_ (read n) $ do
         chan <- newChan
         wid <- forkIO $ forever $ writeChan chan (5::Int)
         rid <- forkIO $ forever $ void $ readChan chan
         threadDelay 1000
         throwTo rid ThreadKilled
         putStr "."
         readChan chan
         throwTo wid ThreadKilled