git.iko.soy/project-m36
on d64cdeb help sign in
project-m36/test/TransactionGraph/Automerge.hs
94 lines 3.8 kB history raw
1import Test.HUnit
2import ProjectM36.Client
3import ProjectM36.Relation
4import qualified Data.Set as S
5import TutorialD.Interpreter.TestBase
7import System.Exit
8import System.IO.Temp
9import System.FilePath
10import Control.Exception.Base
12{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
13main :: IO ()
14main = do
15 tcounts <- runTestTT testList
16 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
18testList :: Test
19testList = TestList [testAutomergeSuccess,
20 testAutomergeFailure,
21 testAutomergeReconnect]
23checkEither :: IO (Either RelationalError a) -> IO a
24checkEither io = do
25 ret <- io
26 case ret of
27 Left err -> assertFailure (show err) >> undefined
28 Right a -> pure a
30testAutomergeSuccess :: Test
31testAutomergeSuccess = TestCase $ do
32 --create two sessions, diverge from the head, and automerge back
33 (sessionId, conn) <- dateExamplesConnection emptyNotificationCallback
34 let headn = "master"
35 sessionPastId <- checkEither $ createSessionAtHead conn headn
36 executeTutorialD sessionId conn "insert s relation{tuple{city \"New City\", s# \"S6\", sname \"Samuels\", status 50}}"
37 checkEither $ commit sessionId conn
39 executeTutorialD sessionPastId conn "insert s relation{tuple{city \"Merge City\", s# \"S7\", sname \"Mr. Merge\", status 60}}"
41 checkEither $ autoMergeToHead sessionPastId conn UnionMergeStrategy headn
43 --validate that both tuples are now in the head transaction
45 let predi = eqAttr
46 eqAttr key = AttributeEqualityPredicate "s#" (NakedAtomExpr (TextAtom key))
47 result <- checkEither $ executeRelationalExpr sessionPastId conn (Project (AttributeNames S.empty) (Restrict (predi "S6") (RelationVariable "s" ())))
48 assertEqual "new S6" relationTrue result
50 result' <- checkEither $ executeRelationalExpr sessionPastId conn (Project (AttributeNames S.empty) (Restrict (predi "S7") (RelationVariable "s" ())))
52 assertEqual "new S7" relationTrue result'
54 eHeadName <- headName sessionPastId conn
55 assertEqual "back on master" (Right "master") eHeadName
57testAutomergeFailure :: Test
58testAutomergeFailure = TestCase $ do
59 --create two sessions, diverge from the head, but create a union merge strategy failure
60 (sessionId, conn) <- dateExamplesConnection emptyNotificationCallback
61 let headn = "master"
62 sessionPastId <- checkEither $ createSessionAtHead conn headn
63 executeTutorialD sessionId conn "insert s relation{tuple{city \"New City\", s# \"S6\", sname \"Samuels\", status 50}}"
64 checkEither $ commit sessionId conn
66 --reuse the same id, violating the uniqueness constraint
67 executeTutorialD sessionPastId conn "insert s relation{tuple{city \"Merge City\", s# \"S6\", sname \"Mr. Merge\", status 60}}"
69 --validate that both tuples are now in the head transaction
70 --should fail
71 mergeRes <- autoMergeToHead sessionPastId conn UnionMergeStrategy headn
73 _ <- checkEither $ executeRelationalExpr sessionPastId conn (RelationVariable "s" ())
75 assertEqual "merge failure" (Left (InclusionDependencyCheckError "s_pkey")) mergeRes
77--reported as #128
78testAutomergeReconnect :: Test
79testAutomergeReconnect = TestCase $ withSystemTempDirectory "m36testdb" $ \tempdir -> do
80 let repro = do
81 conn <- unsafeLeftCrash =<< connectProjectM36 (InProcessConnectionInfo (CrashSafePersistence (tempdir </> "test.db")) emptyNotificationCallback [])
82 sess <- unsafeLeftCrash =<< createSessionAtHead conn "master"
83 autoMergeToHead sess conn UnionMergeStrategy "master"
84 -- commit sess conn
86 unsafeLeftCrash :: Show e => Either e a -> IO a
87 unsafeLeftCrash = either (throwIO . userError . show) pure
88 _ <- repro
89 _ <- repro
90 pure ()