ghc/tests/concurrent/should_run/conc006.hs

   1 module Main where
   2
   3 import Concurrent
   4
   5 -- This test hopefully exercises the black hole code.  The main thread
   6 -- forks off another thread and starts on a large computation.
   7 -- The child thread attempts to get the result of the same large
   8 -- computation (and should get blocked doing so, because the parent
   9 -- won't have evaluated it yet).  When the result is available, the
  10 -- child passes it back to the parent who prints it out.
  11
  12 test = sum [1..10000]
  13
  14 main = do
  15   x <- newEmptyMVar
  16   forkIO (if test > 0
  17                 then putMVar x test
  18                 else error "proc"
  19          )
  20   if test > 0   -- evaluate test
  21         then do result <- takeMVar x
  22                 print result
  23         else error "main"