01345d5 · project-m36 · git.iko.soy

32 tcounts <- runTestTT (TestList tests)

33 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess

34 where

35− tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext expected tutd) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples expected tutd) dateExampleRelTests ++ [transactionGraphBasicTest, transactionGraphAddCommitTest, transactionRollbackTest, transactionJumpTest, transactionBranchTest, simpleJoinTest, testNotification, testTypeConstructors, testMergeTransactions, testComments]

35+ tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext expected tutd) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples expected tutd) dateExampleRelTests ++ [transactionGraphBasicTest, transactionGraphAddCommitTest, transactionRollbackTest, transactionJumpTest, transactionBranchTest, simpleJoinTest, testNotification, testTypeConstructors, testMergeTransactions, testComments, testTransGraphRelationalExpr]

36 simpleRelTests = [("x:=true", Right relationTrue),

37 ("x:=false", Right relationFalse),

38 ("x:=true union false", Right relationTrue),

164transactionRollbackTest = TestCase $ do

165 (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

166 graph <- transactionGraph dbconn

167− maybeErr <- executeDatabaseContextExpr sessionId dbconn (Assign "x" (RelationVariable "s"))

167+ maybeErr <- executeDatabaseContextExpr sessionId dbconn (Assign "x" (RelationVariable "s" ()))

168 case maybeErr of

169 Just err -> assertFailure (show err)

170 Nothing -> do

179transactionJumpTest = TestCase $ do

180 (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

181 (DisconnectedTransaction firstUUID _) <- disconnectedTransaction sessionId dbconn

182− maybeErr <- executeDatabaseContextExpr sessionId dbconn (Assign "x" (RelationVariable "s"))

182+ maybeErr <- executeDatabaseContextExpr sessionId dbconn (Assign "x" (RelationVariable "s" ()))

183 case maybeErr of

184 Just err -> assertFailure (show err)

185 Nothing -> do

197transactionBranchTest = TestCase $ do

198 (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

199 mapM_ (\x -> x >>= maybeFail) [executeGraphExpr sessionId dbconn (Branch "test"),

200− executeDatabaseContextExpr sessionId dbconn (Assign "x" (RelationVariable "s")),

200+ executeDatabaseContextExpr sessionId dbconn (Assign "x" (RelationVariable "s" ())),

201 commit sessionId dbconn,

202 executeGraphExpr sessionId dbconn (JumpToHead "master"),

203− executeDatabaseContextExpr sessionId dbconn (Assign "y" (RelationVariable "s"))

203+ executeDatabaseContextExpr sessionId dbconn (Assign "y" (RelationVariable "s" ()))

204 ]

205 graph <- transactionGraph dbconn

206 assertBool "master branch exists" $ isJust (transactionForHead "master" graph)

252testNotification = TestCase $ do

253 notifmvar <- newEmptyMVar

254 let notifCallback mvar = \_ _ -> putMVar mvar ()

255− relvarx = RelationVariable "x"

255+ relvarx = RelationVariable "x" ()

256 (sess, conn) <- dateExamplesConnection (notifCallback notifmvar)

257 let check' x = x >>= maybe (pure ()) (\err -> assertFailure (show err))

258 check' $ executeDatabaseContextExpr sess conn (Assign "x" (ExistingRelation relationTrue))

286 case mkRelationFromList (attributesFromList [Attribute "conflict" IntAtomType]) [[IntAtom 1],[IntAtom 2]] of

287 Left err -> assertFailure (show err)

288 Right conflictCheck -> do

289− eRv <- executeRelationalExpr sessionId dbconn (RelationVariable "conflictrv")

289+ eRv <- executeRelationalExpr sessionId dbconn (RelationVariable "conflictrv" ())

290 case eRv of

291 Left err -> assertFailure (show err)

292 Right conflictrv -> assertEqual "conflict union merge relvar" conflictCheck conflictrv

298 ":branch testbranch --test comment\n",

299 ":jumphead {- test comment -} master"]

300

301−

301+-- create a graph and query from two disparate contexts

302+testTransGraphRelationalExpr :: Test

303+testTransGraphRelationalExpr = TestCase $ do

304+ (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

305+ mapM_ (executeTutorialD sessionId dbconn) [

306+ ":commit",

307+ ":branch testbranch",

308+ "insert s relation{tuple{city \"Boston\", s# \"S9\", sname \"Smithers\", status 50}}",

309+ ":commit"

310+ ]

311+ let masterMarker = TransactionIdHeadNameLookup "master"

312+ testBranchMarker = TransactionIdHeadNameLookup "testbranch"

313+ sattrs = attributesFromList [Attribute "city" TextAtomType,

314+ Attribute "sname" TextAtomType,

315+ Attribute "s#" TextAtomType,

316+ Attribute "status" IntAtomType]

317+ expectedRel = mkRelationFromList sattrs [[TextAtom "Boston",

318+ TextAtom "Smithers",

319+ TextAtom "S9",

320+ IntAtom 50]]

321+ diff <- executeTransGraphRelationalExpr sessionId dbconn (Difference (RelationVariable "s" testBranchMarker) (RelationVariable "s" masterMarker))

322+ assertEqual "difference in s" expectedRel diff