ghc/tests/concurrent/should_run/conc004.hs

   1 module Main where
   2
   3 -- Test thread creation.
   4 -- (from: Einar Wolfgang Karlsen <ewk@Informatik.Uni-Bremen.DE>)
   5
   6 import Concurrent
   7
   8 main :: IO ()
   9 main = do
  10    mvar <- newEmptyMVar
  11
  12    let
  13         spawner :: (IO () -> IO ThreadId) -> Int -> IO ()
  14         spawner c 0 = putMVar mvar ()
  15         spawner c n = do { c (spawner c (n-1)); return ()}
  16
  17    spawner forkIO 10000000
  18    takeMVar mvar
  19    putStr "done"