git.iko.soy/project-m36
on master help sign in
add schema validation test
commit39c33d152fad5bbd28b31ad321ea3680b42c4de3 authorAgentM <agentm@themactionfaction.com> dateMon 7 Nov 2016, 17:08 (10 years ago) parentafd52b7
3 files changed+25−8
compare with master
unifiedsplit
src/lib/ProjectM36/Error.hs+2−1 src/lib/ProjectM36/IsomorphicSchema.hs+9−5 test/IsomorphicSchema.hs+14−2
src/lib/ProjectM36/Error.hs+2−1
@@ -115,7 +115,8 @@ data AtomFunctionBodyCompilationError = TypeCheckCompilationError String String
115115 deriving (Show,Eq, Generic, Binary, Typeable, NFData)
116116
117117data SchemaError = RelVarReferencesMissing (S.Set RelVarName) |
118− RelVarReferencedMoreThanOnce RelVarName
118+ RelVarInReferencedMoreThanOnce RelVarName |
119+ RelVarOutReferencedMoreThanOnce RelVarName
119120 deriving (Show, Eq, Generic, Binary, Typeable, NFData)
120121
121122
src/lib/ProjectM36/IsomorphicSchema.hs+9−5
@@ -11,7 +11,7 @@ import Data.Binary
1111import qualified Data.Map as M
1212import qualified Data.Set as S
1313import qualified Data.List as L
14−--import Debug.Trace
14+import Debug.Trace
1515-- isomorphic schemas offer bi-directional functors between two schemas
1616
1717--TODO: note that renaming a relvar should alter any stored isomorphisms as well
@@ -37,14 +37,18 @@ validateSchema :: Schema -> DatabaseContext -> Maybe SchemaError
3737validateSchema potentialSchema baseContext = do
3838 if not (S.null rvDiff) then
3939 Just (RelVarReferencesMissing rvDiff)
40− else if not (null duplicateNames) then
41− Just (RelVarReferencedMoreThanOnce (head duplicateNames))
40+ else if not (null outDupes) then
41+ Just (RelVarOutReferencedMoreThanOnce (head outDupes))
42+ else if not (null inDupes) then
43+ Just (RelVarInReferencedMoreThanOnce (head inDupes))
4244 else
4345 Nothing
4446 where
4547 --check that the predicate for IsoUnion and IsoRestrict holds right now
46− duplicateNames = dupes (L.sort outRvNamesList)
47− outRvNamesList = concat (map isomorphOutRelVarNames (isomorphs potentialSchema))
48+ outDupes = duplicateNames (namesList isomorphOutRelVarNames)
49+ inDupes = duplicateNames (namesList isomorphInRelVarNames)
50+ duplicateNames = dupes . L.sort
51+ namesList isoFunc = concat (map isoFunc (isomorphs potentialSchema))
4852 expectedRelVars = M.keysSet (relationVariables baseContext)
4953 schemaRelVars = isomorphsOutRelVarNames (isomorphs potentialSchema)
5054 rvDiff = S.difference expectedRelVars schemaRelVars
test/IsomorphicSchema.hs+14−2
@@ -1,5 +1,6 @@
11import Test.HUnit
22import ProjectM36.Base
3+import ProjectM36.Error
34import ProjectM36.IsomorphicSchema
45import ProjectM36.Relation
56import ProjectM36.RelationalExpression
@@ -7,10 +8,11 @@ import qualified ProjectM36.DatabaseContext as DBC
78import qualified ProjectM36.Attribute as A
89import System.Exit
910import qualified Data.Map as M
11+import qualified Data.Set as S
1012import Control.Monad.State
1113
1214testList :: Test
13−testList = TestList [testIsoRename, testIsoRestrict, testIsoUnion]
15+testList = TestList [testIsoRename, testIsoRestrict, testIsoUnion, testSchemaValidation]
1416
1517main :: IO ()
1618main = do
@@ -25,7 +27,17 @@ assertEither x = case x of
2527-- create some potential schemas which should not be accepted
2628testSchemaValidation :: Test
2729testSchemaValidation = TestCase $ do
28− undefined
30+ let potentialSchema = DBC.basicDatabaseContext {
31+ relationVariables = M.singleton "anotherRel" relationTrue
32+ }
33+ -- missing relvars failure
34+ morphs = [IsoRename "true" "true", IsoRename "false" "false"]
35+ missingRelVarError = Just (RelVarReferencesMissing (S.singleton "anotherRel"))
36+ assertEqual "missing relvar validation" missingRelVarError (validateSchema (Schema morphs) potentialSchema)
37+ -- duplicate relvar mention
38+ let morphs' = [IsoRename "true" "true", IsoRename "false" "true", IsoRename "true" "anotherRel"]
39+ duplicateRelVarError = Just (RelVarOutReferencedMoreThanOnce "true")
40+ assertEqual "duplicate relvars in morphs" duplicateRelVarError (validateSchema (Schema morphs') potentialSchema)
2941
3042testIsoRename :: Test
3143testIsoRename = TestCase $ do