d284af9 · project-m36 · git.iko.soy

Relation.hs+4−1

compare with master

unifiedsplit

@@ -130,10 +130,13 @@ tupleProject projectAttrs tupleIn@(RelationTuple tupleInMap) = RelationTuple $ M

130rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation

131rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet) =

132 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.")

134 else

136 else

135 mkRelation newAttrs newTupSet

137 mkRelation newAttrs newTupSet

136 where

138 where

139+ newAttributeInUse = attributeNamesContained (S.singleton newAttrName) (attributeNames rel)

137 attributeValid = attributeNamesContained (S.singleton oldAttrName) (attributeNames rel)

140 attributeValid = attributeNamesContained (S.singleton oldAttrName) (attributeNames rel)

138 newAttrs = M.delete oldAttrName $ M.insert newAttrName (renameAttribute newAttrName (oldAttrs M.! oldAttrName)) oldAttrs

141 newAttrs = M.delete oldAttrName $ M.insert newAttrName (renameAttribute newAttrName (oldAttrs M.! oldAttrName)) oldAttrs

139 newTupSet = HS.map tupsetmapper oldTupSet

142 newTupSet = HS.map tupsetmapper oldTupSet

RelationTest.hs+24−2

@@ -1,12 +1,19 @@

1import Test.HUnit

2import RelationType

3import Relation

4+import RelationTuple

4import qualified Data.Set as S

5import qualified Data.Set as S

5import qualified Data.Map as M

6import qualified Data.Map as M

6import qualified Data.HashSet as HS

7import qualified Data.HashSet as HS

8+import System.Exit

9+import Control.Monad

7

10

11+

8−testList = TestList [testRelation relationTrue, testRelation relationFalse]

12+testList = TestList [testRelation relationTrue, testRelation relationFalse,

13+ testRename1, testRename2]

14+main = do

9−main = runTestTT testList

15+ counts <- runTestTT testList

16+ if errors counts + failures counts > 0 then exitFailure else exitSuccess

10

17

11testRelation :: Relation -> Test

18testRelation :: Relation -> Test

12testRelation rel = TestCase $ assertEqual "nope" relationValidation (Right rel)

19testRelation rel = TestCase $ assertEqual "nope" relationValidation (Right rel)

@@ -40,4 +47,19 @@ validateAttrTypesMatchTupleAttrTypes rel@(Relation _ tupMapSet)

40 _ -> False

47 _ -> False

41 invalidSet = HS.filter (not . tupleTypeCheck) tupMapSet

48 invalidSet = HS.filter (not . tupleTypeCheck) tupMapSet

42

49

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+

43

65

TutorialDInterpreterTest.hs+4−1

@@ -5,8 +5,11 @@ import Relation

5import RelationType

6import qualified Data.HashSet as HS

7import qualified Data.Map as M

8+import System.Exit

8

9

10+main = do

9−main = runTestTT (TestList tests)

11+ counts <- runTestTT (TestList tests)

12+ if errors counts + failures counts > 0 then exitFailure else exitSuccess

10 where

13 where

11 tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicRelVarContext tutd expected) simpleRelTests

14 tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicRelVarContext tutd expected) simpleRelTests

12 simpleRelTests = [("true", Right relationTrue),

15 simpleRelTests = [("true", Right relationTrue),

project-m36.cabal+6−1

@@ -13,4 +13,9 @@ Executable tutd

13Test-Suite test-tutoriald

14 type: exitcode-stdio-1.0

15 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