git.iko.soy/project-m36
on 6e2c6b0 help sign in
project-m36/TutorialDInterpreterTest.hs
85 lines 5.3 kB history raw
1import TutorialDInterpreter
2import Test.HUnit
3import RelationExpr
4import Relation
5import RelationalError
6import RelationType
7import RelationalTransaction
8import qualified Data.HashSet as HS
9import qualified Data.Map as M
10import System.Exit
11import Data.UUID.V4 (nextRandom)
12import Data.Either (isRight)
14main = do
15 counts <- runTestTT (TestList tests)
16 if errors counts + failures counts > 0 then exitFailure else exitSuccess
17 where
18 tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext tutd expected) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples tutd expected) dateExampleRelTests ++ [transactionGraphBasicTest, transactionGraphAddCommitTest]
19 simpleRelTests = [("x:=true", Right relationTrue),
20 ("x:=false", Right relationFalse),
21 ("x:=true union false", Right relationTrue),
22 ("x:=true; x:=false", Right relationFalse),
23 ("x:=relation{a int}", mkRelation simpleAAttributes HS.empty),
24 ("x:=relation{c int} rename {c as d}", mkRelation simpleBAttributes HS.empty),
25 ("y:=relation{b int, c int}; x:=y{c}", mkRelation simpleProjectionAttributes HS.empty),
26 ("x:=relation{tuple{a char(\"spam\"), b int(5)}}", mkRelation simpleCAttributes (HS.fromList $ map RelationTuple [M.fromList [("a", StringAtom "spam"),("b",IntAtom 5)]])),
27 ("constraint failc true in false; x:=true", Left $ InclusionDependencyCheckError "failc"),
28 ("x:=true where true", Right relationTrue),
29 ("x:=true where false", Right relationFalse),
30 ("x:=true where true or false", Right relationTrue),
31 ("x:=true where false or false", Right relationFalse),
32 ("x:=true where true and false", Right relationFalse),
33 ("x:=true where true and true", Right relationTrue),
34 ("x:=true=true", Right relationTrue),
35 ("x:=true=false", Right relationFalse),
36 ("x:=relation {b int, a char}; insert x relation{tuple{b int(5), a char(\"spam\")}}", mkRelation simpleCAttributes (HS.fromList [RelationTuple $ M.fromList [("a", StringAtom "spam"), ("b", IntAtom 5)]]))
37 ]
38 simpleAAttributes = M.fromList [("a", Attribute "a" IntAtomType)]
39 simpleBAttributes = M.fromList [("d", Attribute "d" IntAtomType)]
40 simpleCAttributes = M.fromList [("a", Attribute "a" StringAtomType), ("b", Attribute "b" IntAtomType)]
41 simpleProjectionAttributes = M.fromList [("c", Attribute "c" IntAtomType)]
42 dateExampleRelTests = [("x:=S where true", Right s),
43 ("x:=S where CITY = \"London\"", restrict (\(RelationTuple tupMap) -> tupMap M.! "CITY" == StringAtom "London") s),
44 ("x:=S where false", Right $ Relation (attributes s) HS.empty),
45 ("a:=S; update a (STATUS:=50); x:=a{STATUS}", mkRelation (M.fromList [("STATUS", Attribute "STATUS" IntAtomType)]) (HS.fromList [RelationTuple $ M.fromList [("STATUS", IntAtom 50)]])),
46 ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\(RelationTuple tupMap) -> RelationTuple $ if tupMap M.! "SNAME" == StringAtom "Blake" then M.insert "CITY" (StringAtom "Boston") tupMap else tupMap) s)
47 ]
49testSimple1 = TestCase $ assertTutdEqual basicDatabaseContext "true" (Right relationTrue)
51assertTutdEqual databaseContext tutd expected = assertEqual tutd interpreted expected
52 where
53 interpreted = case interpret databaseContext tutd of
54 (Just err, _) -> Left err
55 (Nothing, context) -> Right $ (relationVariables context) M.! "x"
57transactionGraphBasicTest = TestCase $ do
58 (discon, graph) <- dateExamplesGraph
59 assertEqual "validate bootstrapped graph" (validateGraph graph) Nothing
61--add a new transaction to the graph, validate it is in the graph
62transactionGraphAddCommitTest = TestCase $ do
63 (discon@(DisconnectedTransaction firstUUID context), graph) <- dateExamplesGraph
64 freshUUID <- nextRandom
65 case interpret context "x:=S" of
66 (Just err, newContext) -> assertFailure (show err)
67 (Nothing, newContext) -> do
68 let discon = newDisconnectedTransaction firstUUID newContext
69 let addTrans = addDisconnectedTransaction freshUUID "master" discon graph
70 case addTrans of
71 Left err -> assertFailure (show err)
72 Right (newTrans, graph) -> do
73 assertBool "transaction in graph" (isRight $ transactionForUUID freshUUID graph)
74 assertEqual "validate fresh commit with deleted S" (validateGraph graph) Nothing
75 assertEqual "ensure S was deleted in newContext" (M.lookup "x" (relationVariables (transactionContext newTrans))) (Just s)
77--test rollback, jump, branch
79dateExamplesGraph :: IO (DisconnectedTransaction, TransactionGraph)
80dateExamplesGraph = do
81 firstTransactionUUID <- nextRandom
82 let graph = bootstrapTransactionGraph firstTransactionUUID dateExamples
83 let discon = newDisconnectedTransaction firstTransactionUUID dateExamples
84 return (discon, graph)