No subject

---
 tests/ghc-regress/lib/Concurrent/QSem002.hs     |   64
+++++++++++++++++++++++
 tests/ghc-regress/lib/Concurrent/QSem002.stdout |   13 +++++
 tests/ghc-regress/lib/Concurrent/all.T          |    1 +
 3 files changed, 78 insertions(+), 0 deletions(-)
 create mode 100644 tests/ghc-regress/lib/Concurrent/QSem002.hs
 create mode 100644 tests/ghc-regress/lib/Concurrent/QSem002.stdout

diff --git a/tests/ghc-regress/lib/Concurrent/QSem002.hs
b/tests/ghc-regress/lib/Concurrent/QSem002.hs
new file mode 100644
index 0000000..62dcfc8
--- /dev/null
+++ b/tests/ghc-regress/lib/Concurrent/QSem002.hs
@@ -0,0 +1,64 @@
+-- Check for fix for #3160, http://hackage.haskell.org/trac/ghc/ticket/3160
+module Main where
+
+import Prelude hiding (read)
+import Control.Concurrent
+import Control.Concurrent.MVar
+import Control.Concurrent.QSem
+import Control.Exception
+import System.Exit
+import System.Timeout
+
+-- delay = threadDelay (1000*100)
+delay = yield
+
+fork x = do m <- newEmptyMVar
+            t <- forkIO (finally x (putMVar m ()))
+            delay
+            return (t,m)
+
+stop (t,m) = do killThread t
+                delay
+                takeMVar m
+
+-- True if test passed, False if test failed
+testSem :: Integral n
+        => String
+        -> (n -> IO a)
+        -> (a->IO ())
+        -> (a -> IO ())
+        -> IO Bool
+testSem name new wait signal = do
+  putStrLn ("\nTest "++ name)
+  q <- new 0
+  putStrLn "0: forkIO wait thread 1"
+  (t1,m1) <- fork $ do
+    wait q `onException` (putStrLn "1: wait interrupted")
+    putStrLn "1: wait done UNEXPECTED"
+  putStrLn "0: stop thread 1"
+  stop (t1,m1)
+  putStrLn "0: signal q #1"
+  signal q
+  delay
+  putStrLn "0: forkIO wait thread 2"
+  (t2,m2) <- fork $ do
+    wait q `onException` (putStrLn "2: wait interrupted UNEXPECTED")
+    putStrLn "2: wait done"
+  putStrLn "0: forkIO wait thread 3"
+  result <- newEmptyMVar
+  (t3,m3) <- fork $ do
+    wait q `onException` (putStrLn "3: wait interrupted (QUANTITY LOST)
FAIL" >> putMVar result False)
+    putStrLn "3: wait done (QUANTITY CONSERVED) PASS"
+    putMVar result True
+  putStrLn "0: signal q #2"
+  signal q
+  delay
+  putStrLn "0: stop thread 2"
+  stop (t2,m2)
+  putStrLn "0: stop thread 3"
+  stop (t3,m3)
+  takeMVar result
+
+main = do
+  _ <- testSem "QSem" newQSem waitQSem signalQSem
+  return ()
diff --git a/tests/ghc-regress/lib/Concurrent/QSem002.stdout
b/tests/ghc-regress/lib/Concurrent/QSem002.stdout
new file mode 100644
index 0000000..36a162c
--- /dev/null
+++ b/tests/ghc-regress/lib/Concurrent/QSem002.stdout
@@ -0,0 +1,13 @@
+
+Test QSem
+0: forkIO wait thread 1
+0: stop thread 1
+1: wait interrupted
+0: signal q #1
+0: forkIO wait thread 2
+2: wait done
+0: forkIO wait thread 3
+0: signal q #2
+3: wait done (QUANTITY CONSERVED) PASS
+0: stop thread 2
+0: stop thread 3
diff --git a/tests/ghc-regress/lib/Concurrent/all.T
b/tests/ghc-regress/lib/Concurrent/all.T
index ac2d8ae..5ba43d0 100644
--- a/tests/ghc-regress/lib/Concurrent/all.T
+++ b/tests/ghc-regress/lib/Concurrent/all.T
@@ -8,3 +8,4 @@ test('MVar001',      reqlib('QuickCheck'),
compile_and_run, ['-package QuickChec
 test('QSemN001',     reqlib('QuickCheck'), compile_and_run, ['-package
QuickCheck'])
 test('QSem001',      reqlib('QuickCheck'), compile_and_run, ['-package
QuickCheck'])
 test('ThreadDelay001', normal, compile_and_run, [''])
+test('QSem002', normal, compile_and_run, [''])