git.iko.soy/project-m36
on master help sign in
WIP
commit6007b73b5069d0d6588f6ec2e432b9b847120627 authorAgentM <agentm@themactionfaction.com> dateSun 7 Jan 2018, 17:50 (9 years ago) parent9d195a0
3 files changed+17−9
compare with master
unifiedsplit
src/lib/ProjectM36/Client.hs+2 src/lib/ProjectM36/Client/Simple.hs+1−1 test/Client/Simple.hs+14−8
src/lib/ProjectM36/Client.hs+2
@@ -595,6 +595,8 @@ autoMergeToHead sessionId (InProcessConnection conf) strat headName' = do
595595 case eSession of
596596 Left err -> pure (Left err)
597597 Right session ->
598+ --attempt fast-forward commit, if possible
599+
598600 case Graph.autoMergeToHead stamp (id1, id2, id3) (Sess.disconnectedTransaction session) headName' strat graph of
599601 Left err -> pure (Left err)
600602 Right (discon', graph') ->
src/lib/ProjectM36/Client/Simple.hs+1−1
@@ -72,7 +72,7 @@ close (_ , conn) = C.close conn
7272withTransaction :: DbConn -> Db a -> IO (Either DbError a)
7373withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy
7474
75−-- | Same a 'withTransaction' except that the merge strategy can be specified.
75+-- | Same as 'withTransaction' except that the merge strategy can be specified.
7676withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
7777withTransactionUsing (sess, conn) strat dbm = do
7878 eHeadName <- C.headName sess conn
test/Client/Simple.hs+14−8
@@ -3,11 +3,14 @@ import Test.HUnit
33import System.Exit
44import ProjectM36.Relation
55import qualified ProjectM36.Client as C
6+import ProjectM36.DateExamples
7+import ProjectM36.DatabaseContext
68import System.IO.Temp
79import System.FilePath
810import ProjectM36.TupleSet
911import ProjectM36.Attribute
1012import qualified Data.Vector as V
13+import qualified Data.Map as M
1114
1215main :: IO ()
1316main = do
@@ -15,7 +18,7 @@ main = do
1518 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
1619
1720testList :: Test
18−testList = TestList [testSimpleCommitSuccess, testSimpleCommitFailure]
21+testList = TestList [testSimpleCommitSuccess, testSimpleCommitFailure, testSimpleUpdate]
1922
2023assertEither :: (Show a) => IO (Either a b) -> IO b
2124assertEither x = do
@@ -45,6 +48,7 @@ testSimpleCommitSuccess = TestCase $
4548 eRes <- C.executeRelationalExpr sess conn relExpr
4649 assertEqual "x and y" (Right relationTrue) eRes
4750
51+
4852testSimpleCommitFailure :: Test
4953testSimpleCommitFailure = TestCase $ do
5054 let failAttrs = attributesFromList [Attribute "fail" IntAtomType]
@@ -57,11 +61,13 @@ testSimpleCommitFailure = TestCase $ do
5761 execute $ Assign "x" (MakeStaticRelation failAttrs emptyTupleSet)
5862 let expectedErr = Left (RelError (RelationTypeMismatchError V.empty failAttrs))
5963 assertEqual "dbc error" expectedErr err
60−
61−
62−
6364
64−
65−
66−
67−
65+-- #176 default merge couldn't handle Update
66+testSimpleUpdate :: Test
67+testSimpleUpdate = TestCase $ do
68+ let connInfo = InProcessConnectionInfo NoPersistence emptyNotificationCallback []
69+ dbconn <- assertEither (simpleConnectProjectM36 connInfo)
70+ assertEither $ withTransaction dbconn $ do
71+ execute $ databaseContextAsDatabaseContextExpr dateExamples
72+ assertEither $ withTransaction dbconn $ do
73+ execute $ Update "s" (M.singleton "sname" (C.NakedAtomExpr (C.TextAtom "Blakey"))) (C.AttributeEqualityPredicate "sname" (C.NakedAtomExpr (C.TextAtom "Blake")))