on master help sign in
100% rename test coverage
commitd284af9ed6983173608f7aa30add9f35488f8765 authorAgentM <agentm@themactionfaction.com> dateWed 29 Oct 2014, 22:10 (12 years ago) parentc6898c3
4 files changed+38−5
Relation.hs+4−1 RelationTest.hs+24−2 TutorialDInterpreterTest.hs+4−1 project-m36.cabal+6−1
Relation.hs+4−1
@@ -130,10 +130,13 @@ tupleProject projectAttrs tupleIn@(RelationTuple tupleInMap) = RelationTuple $ M
130130rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation
131131rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet) =
132132 if not attributeValid
133− then Left $ RelationalError 1 "No such attribute"
133+ then Left $ RelationalError 1 "No such attribute"
134+ else if newAttributeInUse
135+ then Left $ RelationalError 1 ("Attribute \"" ++ newAttrName ++ "\" already in use.")
134136 else
135137 mkRelation newAttrs newTupSet
136138 where
139+ newAttributeInUse = attributeNamesContained (S.singleton newAttrName) (attributeNames rel)
137140 attributeValid = attributeNamesContained (S.singleton oldAttrName) (attributeNames rel)
138141 newAttrs = M.delete oldAttrName $ M.insert newAttrName (renameAttribute newAttrName (oldAttrs M.! oldAttrName)) oldAttrs
139142 newTupSet = HS.map tupsetmapper oldTupSet
RelationTest.hs+24−2
@@ -1,12 +1,19 @@
11import Test.HUnit
22import RelationType
33import Relation
4+import RelationTuple
45import qualified Data.Set as S
56import qualified Data.Map as M
67import qualified Data.HashSet as HS
8+import System.Exit
9+import Control.Monad
710
8−testList = TestList [testRelation relationTrue, testRelation relationFalse]
9−main = runTestTT testList
11+
12+testList = TestList [testRelation relationTrue, testRelation relationFalse,
13+ testRename1, testRename2]
14+main = do
15+ counts <- runTestTT testList
16+ if errors counts + failures counts > 0 then exitFailure else exitSuccess
1017
1118testRelation :: Relation -> Test
1219testRelation rel = TestCase $ assertEqual "nope" relationValidation (Right rel)
@@ -40,4 +47,19 @@ validateAttrTypesMatchTupleAttrTypes rel@(Relation _ tupMapSet)
4047 _ -> False
4148 invalidSet = HS.filter (not . tupleTypeCheck) tupMapSet
4249
50+simpleRel = case mkRelation attrs tupleSet of
51+ Right rel -> rel
52+ where
53+ attrs = M.fromList [("a", Attribute "a" StringAtomType), ("b", Attribute "b" StringAtomType)]
54+ tupleSet = HS.fromList $ mkRelationTuples attrs [
55+ M.fromList [("a", StringAtom "spam"), ("b", StringAtom "spam2")]
56+ ]
57+
58+--rename tests
59+testRename1 :: Test
60+testRename1 = TestCase $ assertEqual "attribute invalid" (rename "a" "b" relationTrue) (Left $ RelationalError 1 "No such attribute")
61+
62+testRename2 :: Test
63+testRename2 = TestCase $ assertEqual "attribute in use" (rename "b" "a" simpleRel) (Left $ RelationalError 1 "Attribute \"a\" already in use.")
64+
4365
TutorialDInterpreterTest.hs+4−1
@@ -5,8 +5,11 @@ import Relation
55import RelationType
66import qualified Data.HashSet as HS
77import qualified Data.Map as M
8+import System.Exit
89
9−main = runTestTT (TestList tests)
10+main = do
11+ counts <- runTestTT (TestList tests)
12+ if errors counts + failures counts > 0 then exitFailure else exitSuccess
1013 where
1114 tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicRelVarContext tutd expected) simpleRelTests
1215 simpleRelTests = [("true", Right relationTrue),
project-m36.cabal+6−1
@@ -13,4 +13,9 @@ Executable tutd
1313Test-Suite test-tutoriald
1414 type: exitcode-stdio-1.0
1515 main-is: TutorialDInterpreterTest.hs
16− Build-Depends: base,HUnit
16+ Build-Depends: base,HUnit,Cabal
17+
18+Test-Suite test-relation
19+ type: exitcode-stdio-1.0
20+ main-is: RelationTest.hs
21+ Build-Depends: base,HUnit,cabal-test-hunit,Cabal