ghc/tests/concurrent/should_run/conc031.hs

   1 import Concurrent
   2 import Exception
   3 import IOExts
   4 import Weak
   5
   6 data P = P (MVar Bool)
   7
   8 -- Bug reported by Manuel Chakravarty, namely that we weren't checking
   9 -- for runnable finalizers before declaring that the program is
  10 -- deadlocked.
  11
  12 main = do
  13 --  gcThread  -- with this thread enabled, no error
  14   mv <- newEmptyMVar
  15   let p = P mv
  16   addFinalizer p (set p)
  17   takeMVar mv >>= print
  18   putStrLn "End."
  19   where
  20     set (P mv) = putMVar mv True
  21     --
  22     -- this is just to demonstrate that it is only about the GC timing
  23     --
  24     gcThread = forkIO $ let gc = do
  25                                    putStrLn "delay"
  26                                    threadDelay 100000
  27                                    putStrLn "gc"
  28                                    performGC
  29                                    gc
  30                         in gc