on 6cbd8a3 help sign in
project-m36/TutorialDInterpreterTest.hs
46 lines 2.6 kB history raw
1import TutorialDInterpreter
2import Test.HUnit
3import RelationExpr
4import Relation
5import RelationalError
6import RelationType
7import qualified Data.HashSet as HS
8import qualified Data.Map as M
9import System.Exit
11main = do
12 counts <- runTestTT (TestList tests)
13 if errors counts + failures counts > 0 then exitFailure else exitSuccess
14 where
15 tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext tutd expected) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples tutd expected) dateExampleRelTests
16 simpleRelTests = [("x:=true", Right relationTrue),
17 ("x:=false", Right relationFalse),
18 ("x:=true union false", Right relationTrue),
19 ("x:=true; x:=false", Right relationFalse),
20 ("x:=relation{a int}", mkRelation simpleAAttributes HS.empty),
21 ("x:=relation{c int} rename {c as d}", mkRelation simpleBAttributes HS.empty),
22 ("y:=relation{b int, c int}; x:=y{c}", mkRelation simpleProjectionAttributes HS.empty),
23 ("constraint failc true in false; x:=true", Left $ InclusionDependencyCheckError "failc"),
24 ("x:=true where true", Right relationTrue),
25 ("x:=true where false", Right relationFalse),
26 ("x:=true where true or false", Right relationTrue),
27 ("x:=true where false or false", Right relationFalse),
28 ("x:=true where true and false", Right relationFalse),
29 ("x:=true where true and true", Right relationTrue)
30 ]
31 simpleAAttributes = M.fromList [("a", Attribute "a" IntAtomType)]
32 simpleBAttributes = M.fromList [("d", Attribute "d" IntAtomType)]
33 simpleProjectionAttributes = M.fromList [("c", Attribute "c" IntAtomType)]
34 dateExampleRelTests = [("x:=S where true", Right s),
35 ("x:=S where CITY = \"London\"", restrict (\(RelationTuple tupMap) -> tupMap M.! "CITY" == StringAtom "London") s),
36 ("x:=S where false", Right $ Relation (attributes s) HS.empty)]
37 --("x:=S where SNO in S{SNO}", Right s)]
40testSimple1 = TestCase $ assertTutdEqual basicDatabaseContext "true" (Right relationTrue)
42assertTutdEqual databaseContext tutd expected = assertEqual tutd interpreted expected
43 where
44 interpreted = case interpret databaseContext tutd of
45 (Just err, _) -> Left err
46 (Nothing, context) -> Right $ (relationVariables context) M.! "x"