git.iko.soy/project-m36
on 62_python_dbapi help sign in
project-m36/test/Relation/Basic.hs
94 lines 4.8 kB history raw
1import Test.HUnit
2import ProjectM36.Base
3import ProjectM36.Relation
4import ProjectM36.Error
5import ProjectM36.DateExamples
6import ProjectM36.DataTypes.Primitive
7import ProjectM36.RelationalExpression
8import ProjectM36.Tuple
9import qualified ProjectM36.DatabaseContext as DBC
10import Control.Monad.State
11import qualified ProjectM36.Attribute as A
12import qualified Data.Map as M
13import qualified Data.Vector as V
14import qualified Data.Set as S
15import System.Exit
18testList :: Test
19testList = TestList [testRelation "relationTrue" relationTrue, testRelation "relationFalse" relationFalse,
20 testMkRelation1,
21 testRename1, testRename2,
22 testRelation "suppliers" suppliersRel,
23 testRelation "products" productsRel,
24 testRelation "supplierProducts" supplierProductsRel,
25 testMkRelationFromExprsBadAttrs]
27main :: IO ()
28main = do
29 tcounts <- runTestTT testList
30 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
32testRelation :: String -> Relation -> Test
33testRelation testName rel = TestCase $ assertEqual testName relationValidation (Right rel)
34 where
35 relationValidation = validateRelation rel
37-- run common relation checks
38validateRelation :: Relation -> Either RelationalError Relation
39validateRelation rel = do
40 _ <- validateAttrNamesMatchTupleAttrNames rel
41 validateAttrTypesMatchTupleAttrTypes rel
43validateAttrNamesMatchTupleAttrNames :: Relation -> Either RelationalError Relation
44validateAttrNamesMatchTupleAttrNames rel@(Relation _ tupSet)
45 | null invalidSet = Right rel
46 | otherwise = Left $ AttributeNamesMismatchError S.empty
47 where
48 nameCheck tuple = attributeNames rel == tupleAttributeNameSet tuple
49 invalidSet = filter (not . nameCheck) (asList tupSet)
51validateAttrTypesMatchTupleAttrTypes :: Relation -> Either RelationalError Relation
52validateAttrTypesMatchTupleAttrTypes rel@(Relation attrs tupSet) = foldr (\tuple acc ->
53 if (tupleAttributes tuple) == attrs && tupleAtomCheck tuple then
54 acc
55 else
56 Left $ TupleAttributeTypeMismatchError A.emptyAttributes
57 ) (Right rel) (asList tupSet)
58 where
59 tupleAtomCheck tuple = V.all (== True) (attrChecks tuple)
60 attrChecks tuple = V.map (\attr -> case atomForAttributeName (A.attributeName attr) tuple of
61 Left _ -> False
62 Right atom -> (Right $ atomTypeForAtom atom) ==
63 A.atomTypeForAttributeName (A.attributeName attr) attrs) (attributes rel)
65simpleRel :: Relation
66simpleRel = case mkRelation attrs tupleSet of
67 Right rel -> rel
68 Left _ -> undefined
69 where
70 attrs = A.attributesFromList [Attribute "a" TextAtomType, Attribute "b" TextAtomType]
71 tupleSet = RelationTupleSet [mkRelationTuple attrs (V.fromList [TextAtom "spam", TextAtom "spam2"])]
73--rename tests
74testRename1 :: Test
75testRename1 = TestCase $ assertEqual "attribute invalid" (rename "a" "b" relationTrue) (Left $ AttributeNamesMismatchError (S.singleton "a"))
77testRename2 :: Test
78testRename2 = TestCase $ assertEqual "attribute in use" (rename "b" "a" simpleRel) (Left $ AttributeNameInUseError "a")
80--mkRelation tests
81--test tupleset key mismatch failure
82testMkRelation1 :: Test
83testMkRelation1 = TestCase $ assertEqual "key mismatch" (Left $ TupleAttributeTypeMismatchError A.emptyAttributes) (mkRelation testAttrs testTupSet) -- the error attribute set is empty due to an optimization- the tuple attrs do not match the atoms' types
84 where
85 testAttrs = A.attributesFromList [Attribute "a" TextAtomType]
86 testTupSet = RelationTupleSet [mkRelationTuple testAttrs $ V.fromList [TextAtom "v"],
87 mkRelationTuple testAttrs $ V.fromList [IntAtom 2]]
89testMkRelationFromExprsBadAttrs :: Test
90testMkRelationFromExprsBadAttrs = TestCase $ do
91 let context = DBC.empty
92 case evalState (evalRelationalExpr (MakeRelationFromExprs (Just [AttributeAndTypeNameExpr "badAttr1" (PrimitiveTypeConstructor "Int" IntAtomType) ()]) [TupleExpr (M.singleton "badAttr2" (NakedAtomExpr (IntAtom 1)))])) (mkRelationalExprState context) of
93 Left err -> assertEqual "tuple type mismatch" (TupleAttributeTypeMismatchError (A.attributesFromList [Attribute "badAttr2" IntAtomType])) err
94 Right _ -> assertFailure "expected tuple type mismatch"