From b07a2716cc0cfe0ed4c5faad2289b85fe9bd3938 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Fri, 25 Aug 2000 13:26:57 +0000
Subject: [PATCH] [project @ 2000-08-25 13:26:57 by simonmar] Add a test (also
 benchmark) for threadDelay, Random, and QSemN.  This test starts a large
 number of threads which all wait for a random delay.  The semaphore is used
 to wait for them all to finish before exiting.

---
 ghc/tests/concurrent/should_run/conc023.hs | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)
 create mode 100644 ghc/tests/concurrent/should_run/conc023.hs

diff --git a/ghc/tests/concurrent/should_run/conc023.hs b/ghc/tests/concurrent/should_run/conc023.hs
new file mode 100644
index 000000000000..d52bac243999
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc023.hs
@@ -0,0 +1,22 @@
+-- !!! test threadDelay, Random, and QSemN.
+
+-- start a large number (n) of threads each of which will wait for a
+-- random delay between 0 and m seconds.  We use a semaphore to wait
+-- for all the threads to finish.
+
+import Random
+import Concurrent
+import Exception
+
+n = 5000  -- no. of threads
+m = 3000  -- maximum delay
+
+main = do
+   s <- newQSemN n
+   (is :: [Int]) <- sequence (take n (repeat (getStdRandom (randomR (1,m)))))
+   mapM (fork_sleep s) is
+   waitQSemN s n
+   where
+	fork_sleep s i = forkIO (do waitQSemN s 1
+			  	    threadDelay (i*1000)
+				    signalQSemN s 1)
-- 
GitLab