git.iko.soy/typeable/postgresql-simple
on master help sign in
typeable/postgresql-simple/test/Serializable.hs
68 lines 2.3 kB history raw
1module Serializable (testSerializable) where
3import Common
4import Control.Concurrent
5import Control.Exception as E
6import Data.IORef
7import Database.PostgreSQL.Simple.Transaction
9initCounter :: Connection -> IO ()
10initCounter conn = do
11 0 <- execute_ conn "DROP TABLE IF EXISTS testSerializableCounter;\
12 \ CREATE TABLE testSerializableCounter (n INT)"
13 1 <- execute_ conn "INSERT INTO testSerializableCounter VALUES (0)"
14 return ()
16getCounter :: Connection -> IO Int
17getCounter conn = do
18 [Only n] <- query_ conn "SELECT n FROM testSerializableCounter"
19 return n
21putCounter :: Connection -> Int -> IO ()
22putCounter conn n = do
23 1 <- execute conn "UPDATE testSerializableCounter SET n=?" (Only n)
24 return ()
26testSerializable :: TestEnv -> Assertion
27testSerializable TestEnv{..} =
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 ()