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