git.iko.soy/project-m36
on master help sign in
add test for multi-process database file access
commit3dbaba908cdb2479ff902aa9927427c28552c8c9 authorAgentM <agentm@themactionfaction.com> dateSat 10 Jun 2017, 21:31 (9 years ago) parent6d932dd
2 files changed+65−1
compare with master
unifiedsplit
project-m36.cabal+12−1 test/MultiProcessDatabaseAccess.hs+53
project-m36.cabal+12−1
@@ -454,4 +454,15 @@ Test-Suite test-atomable
454454 Default-Extensions: OverloadedStrings
455455 GHC-Options: -Wall
456456 Hs-Source-Dirs: ./src/bin, ., test/
457− CPP-Options: -DPROJECTM36_VERSION="v0.1"
457+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
458+
459+Test-Suite test-multiprocess-access
460+ Default-Language: Haskell2010
461+ type: exitcode-stdio-1.0
462+ main-is: test/MultiProcessDatabaseAccess.hs
463+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, uuid-aeson, project-m36 == 0.1, random, MonadRandom
464+ Default-Extensions: OverloadedStrings
465+ GHC-Options: -Wall
466+ Hs-Source-Dirs: ./src/bin, ., test/
467+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
468+
test/MultiProcessDatabaseAccess.hsnew file+53
@@ -0,0 +1,53 @@
1+--tests which cover multi-process access to the same database directory
2+import Test.HUnit
3+import ProjectM36.Client
4+import ProjectM36.Error
5+
6+import System.IO.Temp
7+import System.Exit
8+import System.FilePath
9+
10+main :: IO ()
11+main = do
12+ tcounts <- runTestTT testList
13+ if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
14+
15+assertIOEither :: (Show a) => IO (Either a b) -> IO b
16+assertIOEither x = do
17+ ret <- x
18+ case ret of
19+ Left err -> assertFailure (show err) >> undefined
20+ Right val -> pure val
21+
22+assertIONothing :: (Show a) => IO (Maybe a) -> IO ()
23+assertIONothing x = do
24+ ret <- x
25+ case ret of
26+ Nothing -> pure ()
27+ Just err -> assertFailure (show err)
28+
29+testList :: Test
30+testList = TestList [testMultipleProcessAccess]
31+
32+testMultipleProcessAccess :: Test
33+testMultipleProcessAccess = TestCase $ do
34+ withSystemTempDirectory "pm36" $ \tmpdir -> do
35+ let connInfo = InProcessConnectionInfo (MinimalPersistence dbdir) emptyNotificationCallback []
36+ master = "master"
37+ dudExpr = Assign "x" (RelationVariable "true" ())
38+ dbdir = tmpdir </> "db"
39+ conn1 <- assertIOEither $ connectProjectM36 connInfo
40+ conn2 <- assertIOEither $ connectProjectM36 connInfo
41+ session1 <- assertIOEither (createSessionAtHead master conn1)
42+ session2 <- assertIOEither (createSessionAtHead master conn2)
43+ --add a commit on conn1 which conn2 doesn't know about
44+ assertIONothing $ executeDatabaseContextExpr session1 conn1 dudExpr
45+ assertIONothing $ commit session1 conn1
46+
47+ assertIONothing $ executeDatabaseContextExpr session2 conn2 dudExpr
48+ mHeadId <- headTransactionId session2 conn2
49+ headId <- case mHeadId of
50+ Nothing -> assertFailure "headTransactionId failed"
51+ Just x -> pure x
52+ res <- commit session2 conn2
53+ assertEqual "commit should fail" (Just (TransactionIsNotAHeadError headId)) res