git.iko.soy/typeable/postgresql-simple
on 32f1aae help sign in
typeable/postgresql-simple/test/Serializable.hs
69 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 -> Test
27testSerializable TestEnv{..} =
28 TestCase $
29 withConn $ \conn2 -> do
30 initCounter conn
32 attemptCounter <- newIORef (0 :: Int)
33 readyToBother <- newEmptyMVar
34 bothered <- newEmptyMVar
35 finished <- newEmptyMVar
37 _ <- forkIO $ do
38 withTransactionSerializable conn2 $ do
39 modifyIORef attemptCounter (+1)
40 n <- getCounter conn2
41 True <- tryPutMVar readyToBother ()
42 readMVar bothered
43 putCounter conn2 (n+1)
44 putMVar finished ()
46 takeMVar readyToBother
47 withTransactionSerializable conn $ do
48 n <- getCounter conn
49 putCounter conn (n+1)
50 True <- tryPutMVar bothered ()
52 takeMVar finished
54 ac <- readIORef attemptCounter
55 assertEqual "attemptCounter" 2 ac
57 ok <- E.catch (do withTransactionSerializable conn (fail "Whoops")
58 return False)
59 (\(_ :: IOException) -> return True)
60 assertBool "Exceptions (besides serialization failure) should be\
61 \ propagated through withTransactionSerializable"
62 ok
64 -- Make sure transaction isn't dangling
65 1 <- execute_ conn "UPDATE testSerializableCounter SET n=12345"
66 0 <- execute_ conn "ROLLBACK"
67 -- This prints "NOTICE: there is no transaction in progress"
68 [Only (12345 :: Int)] <- query_ conn "SELECT n FROM testSerializableCounter"
69 return ()