git.iko.soy/typeable/postgresql-simple
on 592fe13 help sign in
68 lines 2.3 kB history raw
1module Serializable (testSerializable) where
3import Common
4import Control.Concurrent
5import Control.Exception as E
6import Data.IORef
8initCounter :: Connection -> IO ()
9initCounter conn = do
10 0 <- execute_ conn "DROP TABLE IF EXISTS testSerializableCounter;\
11 \ CREATE TABLE testSerializableCounter (n INT)"
12 1 <- execute_ conn "INSERT INTO testSerializableCounter VALUES (0)"
13 return ()
15getCounter :: Connection -> IO Int
16getCounter conn = do
17 [Only n] <- query_ conn "SELECT n FROM testSerializableCounter"
18 return n
20putCounter :: Connection -> Int -> IO ()
21putCounter conn n = do
22 1 <- execute conn "UPDATE testSerializableCounter SET n=?" (Only n)
23 return ()
25testSerializable :: TestEnv -> Test
26testSerializable TestEnv{..} =
27 TestCase $
28 withConn $ \conn2 -> do
29 initCounter conn
31 attemptCounter <- newIORef (0 :: Int)
32 readyToBother <- newEmptyMVar
33 bothered <- newEmptyMVar
34 finished <- newEmptyMVar
36 _ <- forkIO $ do
37 withTransactionSerializable conn2 $ do
38 modifyIORef attemptCounter (+1)
39 n <- getCounter conn2
40 True <- tryPutMVar readyToBother ()
41 readMVar bothered
42 putCounter conn2 (n+1)
43 putMVar finished ()
45 takeMVar readyToBother
46 withTransactionSerializable conn $ do
47 n <- getCounter conn
48 putCounter conn (n+1)
49 True <- tryPutMVar bothered ()
51 takeMVar finished
53 ac <- readIORef attemptCounter
54 assertEqual "attemptCounter" 2 ac
56 ok <- E.catch (do withTransactionSerializable conn (fail "Whoops")
57 return False)
58 (\(_ :: IOException) -> return True)
59 assertBool "Exceptions (besides serialization failure) should be\
60 \ propagated through withTransactionSerializable"
61 ok
63 -- Make sure transaction isn't dangling
64 1 <- execute_ conn "UPDATE testSerializableCounter SET n=12345"
65 0 <- execute_ conn "ROLLBACK"
66 -- This prints "NOTICE: there is no transaction in progress"
67 [Only (12345 :: Int)] <- query_ conn "SELECT n FROM testSerializableCounter"
68 return ()