git.iko.soy/project-m36
on 5cc025d help sign in
project-m36/RelationTest.hs
74 lines 3.0 kB history raw
1import Test.HUnit
2import RelationType
3import Relation
4import RelationTuple
5import RelationTupleSet
6import qualified Data.Set as S
7import qualified Data.Map as M
8import qualified Data.HashSet as HS
9import System.Exit
10import Control.Monad
13testList = TestList [testRelation relationTrue, testRelation relationFalse,
14 testRename1, testRename2]
15main = do
16 counts <- runTestTT testList
17 if errors counts + failures counts > 0 then exitFailure else exitSuccess
19testRelation :: Relation -> Test
20testRelation rel = TestCase $ assertEqual "nope" relationValidation (Right rel)
21 where
22 relationValidation = validateRelation rel
24-- run common relation checks
25validateRelation :: Relation -> Either RelationalError Relation
26validateRelation rel = do
27 validateAttrNamesMatchTupleAttrNames rel
28 validateAttrTypesMatchTupleAttrTypes rel
30validateAttrNamesMatchTupleAttrNames :: Relation -> Either RelationalError Relation
31validateAttrNamesMatchTupleAttrNames rel@(Relation _ tupMapSet)
32 | HS.null invalidSet = Right rel
33 | otherwise = Left (RelationalError 1 "Tuple attributes do not match relation attributes")
34 where
35 nameCheck (RelationTuple tupMap) = attributeNames rel == M.keysSet tupMap
36 relAttrNames = attributeNames rel
37 invalidSet = HS.filter (not . nameCheck) tupMapSet
40validateAttrTypesMatchTupleAttrTypes :: Relation -> Either RelationalError Relation
41validateAttrTypesMatchTupleAttrTypes rel@(Relation _ tupMapSet)
42 | HS.null invalidSet = Right rel
43 | otherwise = Left (RelationalError 1 "Tuple types do not match relation attribute types")
44 where
45 tupleTypeCheck (RelationTuple tupMap) = M.null $ M.filterWithKey attrTypeCheck tupMap
46 attrTypeCheck attrName atomValue = case attributeTypeForName attrName rel of
47 Just t -> atomValueType atomValue == t
48 _ -> False
49 invalidSet = HS.filter (not . tupleTypeCheck) tupMapSet
51simpleRel = case mkRelation attrs tupleSet of
52 Right rel -> rel
53 Left err -> undefined
54 where
55 attrs = M.fromList [("a", Attribute "a" StringAtomType), ("b", Attribute "b" StringAtomType)]
56 tupleSet = HS.fromList $ mkRelationTuples attrs [
57 M.fromList [("a", StringAtom "spam"), ("b", StringAtom "spam2")]
58 ]
60--rename tests
61testRename1 :: Test
62testRename1 = TestCase $ assertEqual "attribute invalid" (rename "a" "b" relationTrue) (Left $ RelationalError 1 "No such attribute")
64testRename2 :: Test
65testRename2 = TestCase $ assertEqual "attribute in use" (rename "b" "a" simpleRel) (Left $ RelationalError 1 "Attribute \"a\" already in use.")
67--mkRelation tests
68--test tupleset key mismatch failure
69testMkRelation1 :: Test
70testMkRelation1 = TestCase $ assertEqual "key mismatch" (mkRelation testAttrs testTupSet) (Left $ RelationalError 1 "Tuple values not of the same type for same keys")
71 where
72 testAttrs = M.singleton "a" (Attribute "a" StringAtomType)
73 testTupSet = HS.fromList [(RelationTuple (M.singleton "a" $ StringAtom "v")),
74 RelationTuple (M.singleton "a" $ IntAtom 2)]