ghc/tests/concurrent/should_run/conc023.hs

   1 -- !!! test threadDelay, Random, and QSemN.
   2
   3 -- start a large number (n) of threads each of which will wait for a
   4 -- random delay between 0 and m seconds.  We use a semaphore to wait
   5 -- for all the threads to finish.
   6
   7 import Random
   8 import Concurrent
   9 import Exception
  10
  11 n = 5000  -- no. of threads
  12 m = 3000  -- maximum delay
  13
  14 main = do
  15    s <- newQSemN n
  16    (is :: [Int]) <- sequence (take n (repeat (getStdRandom (randomR (1,m)))))
  17    mapM (fork_sleep s) is
  18    waitQSemN s n
  19    where
  20         fork_sleep s i = forkIO (do waitQSemN s 1
  21                                     threadDelay (i*1000)
  22                                     signalQSemN s 1)