git.iko.soy/project-m36
on fbfa2ea help sign in
project-m36/test/MultiProcessDatabaseAccess.hs
46 lines 1.7 kB history raw
1--tests which cover multi-process access to the same database directory
2import Test.HUnit
3import ProjectM36.Client
4import ProjectM36.Error
6import System.IO.Temp
7import System.Exit
8import System.FilePath
10main :: IO ()
11main = do
12 tcounts <- runTestTT testList
13 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
15assertIOEither :: (Show a) => IO (Either a b) -> IO b
16assertIOEither x = do
17 ret <- x
18 case ret of
19 Left err -> assertFailure (show err) >> undefined
20 Right val -> pure val
22testList :: Test
23testList = TestList [testMultipleProcessAccess]
25testMultipleProcessAccess :: Test
26testMultipleProcessAccess = TestCase $
27 withSystemTempDirectory "pm36" $ \tmpdir -> do
28 let connInfo = InProcessConnectionInfo (MinimalPersistence dbdir) emptyNotificationCallback []
29 master = "master"
30 dudExpr = Assign "x" (RelationVariable "true" ())
31 dbdir = tmpdir </> "db"
32 conn1 <- assertIOEither $ connectProjectM36 connInfo
33 conn2 <- assertIOEither $ connectProjectM36 connInfo
34 session1 <- assertIOEither (createSessionAtHead conn1 master)
35 session2 <- assertIOEither (createSessionAtHead conn2 master)
36 --add a commit on conn1 which conn2 doesn't know about
37 assertIOEither $ executeDatabaseContextExpr session1 conn1 dudExpr
38 assertIOEither $ commit session1 conn1
40 assertIOEither $ executeDatabaseContextExpr session2 conn2 dudExpr
41 eHeadId <- headTransactionId session2 conn2
42 headId <- case eHeadId of
43 Left err -> assertFailure ("headTransactionId failed: " ++ show err) >> undefined
44 Right x -> pure x
45 res <- commit session2 conn2
46 assertEqual "commit should fail" (Left (TransactionIsNotAHeadError headId)) res