1 files changed, 21 insertions, 0 deletions

diff --git a/lifted-concurrent/test/TestThreads.hs b/lifted-concurrent/test/TestThreads.hs
new file mode 100644
index 00000000..8360badb
--- /dev/null
+++ b/lifted-concurrent/test/TestThreads.hs
@@ -0,0 +1,21 @@
+import Control.Monad
+import Control.Exception (throwIO)
+
+import Control.Concurrent.ThreadUtil
+import DebugUtil
+
+main = do
+    mvars <- sequence $ replicate 200 $ newEmptyMVar
+    threads <- forM mvars $ forkIO . join . takeMVar
+    let (normalquits,mvars1) = splitAt 20 mvars
+    mapM_ (`putMVar` return ()) normalquits
+    let (exceptionquits,mvars2) = splitAt 20 mvars1
+    mapM_ (`putMVar` throwIO (userError "oops")) exceptionquits
+    let (throwtoexceptions,threads1) = splitAt 20 $ drop 40 threads
+    mapM_ (`throwTo` userError "throwTo-oops") throwtoexceptions
+    let (killed,threads2) = splitAt 20 threads1
+    mapM_ killThread killed
+    threadDelay 1000000
+    report <- threadReport True
+    sequence_ $ zipWith (\n s -> putStrLn $ unwords [show n,s]) [1..] $ lines report
+    return ()