git.iko.soy/project-m36
on master help sign in
all tests pass
commit9b6ae14a8754144b9fba977dd962ee7ffd63c40a authorAgentM <agentm@themactionfaction.com> dateFri 3 Mar 2017, 10:53 (10 years ago) parent47073bc
8 files changed+45−19
compare with master
unifiedsplit
src/lib/ProjectM36/DatabaseContextExpression.hs+1 src/lib/ProjectM36/InclusionDependencyValidation.hs+2−1 src/lib/ProjectM36/StaticOptimizer/InclusionDependencies.hs+4−4 test/IsomorphicSchema.hs+13−3 test/Relation/Basic.hs+1 test/Relation/StaticOptimizer.hs+10−4 test/TransactionGraph/Merge.hs+13−6 test/TutorialD/Interpreter.hs+1−1
src/lib/ProjectM36/DatabaseContextExpression.hs+1
@@ -153,6 +153,7 @@ evalContextExpr expr@(AddInclusionDependency newDepName newDep) = do
153153 return $ Just (InclusionDependencyNameInUseError newDepName)
154154 else do
155155 let potentialContext = currContext { inclusionDependencies = newDeps }
156+ --when adding a constraint, it is new and must be unconditionally validated without being optimized away
156157 validateConstraints expr potentialContext
157158
158159evalContextExpr (RemoveInclusionDependency depName) = do
src/lib/ProjectM36/InclusionDependencyValidation.hs+2−1
@@ -14,7 +14,8 @@ checkConstraints expr context = case optimizedIncDepMap of
1414 Left err -> Just err
1515 Right filteredIncDepMap -> case failures filteredIncDepMap of
1616 [] -> Nothing
17− l -> Just (MultipleErrors l)
17+ err:[] -> Just err
18+ list -> Just (MultipleErrors list)
1819 where
1920 optimizedIncDepMap = filterInclusionDependenciesForValidation expr deps
2021 failures incDeps = M.elems $ M.mapMaybeWithKey checkIncDep incDeps
src/lib/ProjectM36/StaticOptimizer/InclusionDependencies.hs+4−4
@@ -27,8 +27,8 @@ inclusionDependencyValidation (Delete name _) incDep = _nameInIncDepValidation
2727
2828inclusionDependencyValidation (Update name _ _) incDep = _nameInIncDepValidation name incDep
2929
30−--inc deps can't violate another inc dep- there is no change in relvars
31−inclusionDependencyValidation (AddInclusionDependency _ _) _ = NoValidationNeeded
30+--inc deps can't violate another inc dep- there is no change in relvars, but a new inc dep must be unconditionally validated
31+inclusionDependencyValidation (AddInclusionDependency _ _) _ = ValidationNeeded
3232
3333inclusionDependencyValidation (RemoveInclusionDependency _) _ = NoValidationNeeded
3434
@@ -71,7 +71,7 @@ data Validation = NoValidationNeeded |
7171 deriving (Eq, Show, Ord)
7272
7373filterInclusionDependenciesForValidation :: DatabaseContextExpr -> InclusionDependencies -> Either RelationalError InclusionDependencies
74−filterInclusionDependenciesForValidation context incDeps = if length errors > 0 then
74+filterInclusionDependenciesForValidation expr incDeps = if length errors > 0 then
7575 Left (MultipleErrors errors)
7676 else
7777 Right filteredIncDeps
@@ -79,6 +79,6 @@ filterInclusionDependenciesForValidation context incDeps = if length errors > 0
7979 filteredIncDeps = M.filterWithKey (\incDepName _ -> M.member incDepName needValidation) incDeps
8080 violated = M.filter ((==) Violated) validationMap
8181 errors = map InclusionDependencyCheckError (M.keys violated)
82− validationMap = M.map (inclusionDependencyValidation context) incDeps
82+ validationMap = M.map (inclusionDependencyValidation expr) incDeps
8383 needValidation = M.filter ((==) ValidationNeeded) validationMap
8484
test/IsomorphicSchema.hs+13−3
@@ -4,6 +4,9 @@ import ProjectM36.Error
44import ProjectM36.IsomorphicSchema
55import ProjectM36.Relation
66import ProjectM36.RelationalExpression
7+import ProjectM36.DatabaseContextExpression
8+import ProjectM36.RelationalExpressionState
9+import ProjectM36.InclusionDependencyValidation
710import qualified ProjectM36.DatabaseContext as DBC
811import qualified ProjectM36.Attribute as A
912import System.Exit
@@ -30,6 +33,13 @@ assertMaybe x msg = case x of
3033 Nothing -> assertFailure msg >> undefined
3134 Just x' -> pure x'
3235-}
36+
37+--copied from ProjectM36.Client so that Client doesn't need to export this
38+defaultDatabaseContextEvalState :: DatabaseContext -> DatabaseContextEvalState
39+defaultDatabaseContextEvalState context = DatabaseContextEvalState {
40+ dbcontext = context,
41+ constraintValidator = checkConstraints
42+ }
3343
3444-- create some potential schemas which should not be accepted
3545testSchemaValidation :: Test
@@ -92,11 +102,11 @@ testIsoRestrict = TestCase $ do
92102 bobRel <- assertEither (mkRelationFromList empattrs [[TextAtom "Bob", TextAtom ""]])
93103 let schemaBInsertExpr = Insert "employee" (ExistingRelation bobRel)
94104 schemaBInsertExpr' <- assertEither (processDatabaseContextExprInSchema (Schema isomorphsAtoB) schemaBInsertExpr)
95− let postInsertContext = execState (evalContextExpr schemaBInsertExpr') (stateContext schemaA)
96− expectedRel = evalState (evalRelationalExpr (Union (RelationVariable "boss" ()) (RelationVariable "nonboss" ()))) (mkRelationalExprState postInsertContext)
105+ let postInsertState = execState (evalContextExpr schemaBInsertExpr') (defaultDatabaseContextEvalState (stateContext schemaA))
106+ expectedRel = evalState (evalRelationalExpr (Union (RelationVariable "boss" ()) (RelationVariable "nonboss" ()))) (mkRelationalExprState (dbcontext postInsertState))
97107 --execute the expression against the schema and compare against the base context
98108 processedExpr <- assertEither (processRelationalExprInSchema (Schema isomorphsAtoB) (RelationVariable "employee" ()))
99− let processedRel = evalState (evalRelationalExpr processedExpr) (mkRelationalExprState postInsertContext)
109+ let processedRel = evalState (evalRelationalExpr processedExpr) (mkRelationalExprState (dbcontext postInsertState))
100110 assertEqual "insert bob boss" expectedRel processedRel
101111
102112testIsoUnion :: Test
test/Relation/Basic.hs+1
@@ -6,6 +6,7 @@ import ProjectM36.DateExamples
66import ProjectM36.DataTypes.Primitive
77import ProjectM36.RelationalExpression
88import ProjectM36.Tuple
9+import ProjectM36.RelationalExpressionState
910import qualified ProjectM36.DatabaseContext as DBC
1011import Control.Monad.State
1112import qualified ProjectM36.Attribute as A
test/Relation/StaticOptimizer.hs+10−4
@@ -3,9 +3,13 @@ import ProjectM36.Relation
33import ProjectM36.RelationalExpression
44import ProjectM36.DateExamples
55import ProjectM36.TupleSet
6−import ProjectM36.StaticOptimizer
6+import ProjectM36.StaticOptimizer.DatabaseContextExpression
7+import ProjectM36.StaticOptimizer.InclusionDependencies
8+import ProjectM36.StaticOptimizer.RelationalExpression
9+import ProjectM36.InclusionDependencyValidation
10+import ProjectM36.RelationalExpressionState
11+import ProjectM36.DatabaseContextExpression
712import ProjectM36.Key
8−import ProjectM36.InclusionDependency
913import System.Exit
1014import Control.Monad.State
1115import Test.HUnit
@@ -17,16 +21,18 @@ main = do
1721 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
1822 where
1923 tests = relationOptTests ++ databaseOptTests ++ [testIncDepOptimizer]
24+ dateDBState = DatabaseContextEvalState { dbcontext = dateExamples,
25+ constraintValidator = checkConstraints }
2026 optTest optfunc estate testparams = map (\(name, expr, unopt) -> TestCase $ assertEqual name expr (evalState (optfunc unopt) estate)) $ testparams
2127 relvar nam = RelationVariable nam ()
22− relationOptTests = optTest applyStaticRelationalOptimization (mkRelationalExprState dateExamples) [
28+ relationOptTests = optTest applyStaticRelationalOptimization (mkRelationalExprState dateExamples) [
2329 ("StaticProject", Right $ relvar "s", Project (AttributeNames (attributeNames suppliersRel)) (relvar "s")),
2430 ("StaticUnion", Right $ relvar "s", Union (relvar "s") (relvar "s")),
2531 ("StaticJoin", Right $ relvar "s", Join (relvar "s") (relvar "s")),
2632 ("StaticRestrictTrue", Right $ relvar "s", Restrict TruePredicate (relvar "s")),
2733 ("StaticRestrictFalse", Right $ MakeStaticRelation (attributes suppliersRel) emptyTupleSet, Restrict (NotPredicate TruePredicate) (relvar "s"))
2834 ]
29− databaseOptTests = optTest applyStaticDatabaseOptimization dateExamples [
35+ databaseOptTests = optTest applyStaticDatabaseOptimization dateDBState [
3036 ("StaticAssign",
3137 Right $ Assign "z" (relvar "s"),
3238 Assign "z" (Restrict TruePredicate (relvar "s"))
test/TransactionGraph/Merge.hs+13−6
@@ -9,7 +9,8 @@ import ProjectM36.Error
99import qualified Data.ByteString.Lazy as BS
1010import System.Exit
1111import Data.Word
12−import ProjectM36.RelationalExpression
12+import ProjectM36.DatabaseContextExpression
13+import ProjectM36.InclusionDependencyValidation
1314import qualified ProjectM36.DisconnectedTransaction as Discon
1415import qualified Data.UUID as U
1516import qualified Data.Set as S
@@ -38,10 +39,16 @@ root 1
3839|--- branchA aaaa
3940|--- branchB bbbb
4041-}
41−
4242createTrans :: TransactionId -> TransactionInfo -> DatabaseContext -> Transaction
4343createTrans tid info ctx = Transaction tid info (Schemas ctx M.empty)
4444
45+--copied from ProjectM36.Client so that Client doesn't need to export this
46+defaultDatabaseContextEvalState :: DatabaseContext -> DatabaseContextEvalState
47+defaultDatabaseContextEvalState context = DatabaseContextEvalState {
48+ dbcontext = context,
49+ constraintValidator = checkConstraints
50+ }
51+
4552basicTransactionGraph :: IO TransactionGraph
4653basicTransactionGraph = do
4754 let bsGraph = bootstrapTransactionGraph uuidRoot DBC.empty --dateExamples
@@ -113,10 +120,10 @@ testSubGraphToFirstAncestorMoreTransactions = TestCase $ do
113120
114121 -- add another relvar to branchB
115122 branchBTrans <- assertMaybe (transactionForHead "branchB" graph) "failed to get branchB head"
116− updatedBranchBContext <- case runState (evalContextExpr (Assign "branchBOnlyRelvar" (ExistingRelation relationTrue))) (concreteDatabaseContext branchBTrans) of
123+ updatedBranchBContext <- case runState (evalContextExpr (Assign "branchBOnlyRelvar" (ExistingRelation relationTrue))) (defaultDatabaseContextEvalState (concreteDatabaseContext branchBTrans)) of
117124 (Just err, _) -> assertFailure (show err) >> undefined
118125 (Nothing, context) -> pure context
119− (_, graph') <- addTransaction "branchB" (createTrans (fakeUUID 3) (TransactionInfo (transactionId branchBTrans) S.empty) updatedBranchBContext) graph
126+ (_, graph') <- addTransaction "branchB" (createTrans (fakeUUID 3) (TransactionInfo (transactionId branchBTrans) S.empty) (dbcontext updatedBranchBContext)) graph
120127 branchBTrans' <- assertMaybe (transactionForHead "branchB" graph') "failed to get branchB head"
121128 assertEqual "branchB id 3" (fakeUUID 3) (transactionId branchBTrans')
122129
@@ -140,10 +147,10 @@ testSelectedBranchMerge = TestCase $ do
140147
141148 -- add another relvar to branchB
142149 branchBTrans <- assertMaybe (transactionForHead "branchB" graph) "failed to get branchB head"
143− updatedBranchBContext <- case runState (evalContextExpr (Assign "branchBOnlyRelvar" (ExistingRelation relationTrue))) (concreteDatabaseContext branchBTrans) of
150+ updatedBranchBContext <- case runState (evalContextExpr (Assign "branchBOnlyRelvar" (ExistingRelation relationTrue))) (defaultDatabaseContextEvalState (concreteDatabaseContext branchBTrans)) of
144151 (Just err, _) -> assertFailure (show err) >> undefined
145152 (Nothing, context) -> pure context
146− (_, graph') <- addTransaction "branchB" (createTrans (fakeUUID 3) (TransactionInfo (transactionId branchBTrans) S.empty) updatedBranchBContext) graph
153+ (_, graph') <- addTransaction "branchB" (createTrans (fakeUUID 3) (TransactionInfo (transactionId branchBTrans) S.empty) (dbcontext updatedBranchBContext)) graph
147154 --create the merge transaction in the graph
148155 let eGraph' = mergeTransactions (fakeUUID 4) (fakeUUID 10) (SelectedBranchMergeStrategy "branchA") ("branchA", "branchB") graph'
149156
test/TutorialD/Interpreter.hs+1−1
@@ -391,6 +391,6 @@ testFunctionalDependencies = TestCase $ do
391391 --insert a new, valid tuple
392392 executeTutorialD sessionId dbconn "insert s relation{tuple{city \"Boston\", s# \"S6\", sname \"Stevens\", status 30}}"
393393 --insert an constraint-violating tuple
394− let expectedError = InclusionDependencyCheckError "sname_status_A"
394+ let expectedError = MultipleErrors (map InclusionDependencyCheckError ["sname_status_A", "sname_status_B"])
395395 expectTutorialDErr sessionId dbconn expectedError "insert s relation{tuple{city \"Boston\", s# \"S7\", sname \"Jones\", status 20}}"
396396