Add testcase for #14171
authorBen Gamari <ben@smart-cactus.org>
Thu, 31 Aug 2017 20:03:28 +0000 (16:03 -0400)
committerBen Gamari <ben@smart-cactus.org>
Wed, 13 Sep 2017 20:52:24 +0000 (16:52 -0400)
tests/T14171.hs [new file with mode: 0644]
tests/T14171.stderr [new file with mode: 0644]
tests/all.T

diff --git a/tests/T14171.hs b/tests/T14171.hs
new file mode 100644 (file)
index 0000000..d9a32b7
--- /dev/null
@@ -0,0 +1,38 @@
+module Main where
+
+import Control.Concurrent.STM
+import Control.Concurrent.STM.TVar
+
+data A = A String deriving (Eq, Show)
+
+data E = E {
+  a :: TVar [Int],
+  b :: TVar A,
+  c :: TVar [Int]
+  }
+
+consistency_1 :: E -> STM Bool
+consistency_1 = \e -> do
+  _ <- readTVar $ c e
+  return True
+
+installSanityChecks :: E -> IO ()
+installSanityChecks e = do
+  x e
+  fail "You should see this failure"
+
+x :: E -> IO ()
+x e = do
+  -- This unexpected succeeds
+  atomically $ installCheck consistency_1
+  -- error "derp2"
+  where
+    installCheck check = always $ check e
+
+main :: IO ()
+main = do
+  state <- initialize
+  installSanityChecks state
+
+initialize :: IO E
+initialize = E <$> newTVarIO [] <*> newTVarIO (A "USD") <*> newTVarIO []
diff --git a/tests/T14171.stderr b/tests/T14171.stderr
new file mode 100644 (file)
index 0000000..84de5c7
--- /dev/null
@@ -0,0 +1 @@
+T14171: user error (You should see this failure)
index 213ea75..c2ea89e 100644 (file)
@@ -28,5 +28,5 @@ test('T3049', normal, compile_and_run, ['-package stm'])
 test('T4057', normal, compile_and_run, ['-package stm'])
 test('stm064', normal, compile_and_run, ['-package stm'])
 test('stm065', normal, compile_and_run, ['-package stm'])
-
 test('cloneTChan001', normal, compile_and_run, ['-package stm'])
+test('T14171', exit_code(1), compile_and_run, ['-package stm'])