testsuite: Add test for ghc#16707

Author: bgamari

tests/T16707.hs

@@ -0,0 +1,20 @@
+import Control.Concurrent
+import Control.Concurrent.STM
+import Debug.Trace
+
+main :: IO ()
+main = (`mapM_` [1..1000]) $ \_ -> do
+  traceEventIO "(((("
+
+  x <- newTVarIO False
+
+  forkIO $ atomically $ writeTVar x True
+
+  traceEventIO "----"
+
+  atomically $ do  -- hangs in the second iteration
+    _ <- readTVar x
+    writeTVar x True `orElse` return ()
+
+  threadDelay 100000
+  traceEventIO "))))"

tests/all.T

@@ -26,3 +26,4 @@ test('stm065', normal, compile_and_run, ['-package stm'])
 test('cloneTChan001', normal, compile_and_run, ['-package stm'])
 
 test('T15136', extra_run_opts('20'), compile_and_run, ['-package stm'])
+test('T16707', normal, compile_and_run, [''])