@@ -2,6 +2,7 @@ import ProjectM36.Base
22import ProjectM36.Relation
33import ProjectM36.RelationalExpression
44import ProjectM36.DateExamples
5+import ProjectM36.Error
56import ProjectM36.TupleSet
67import ProjectM36.StaticOptimizer
78import System.Exit
@@ -14,7 +15,8 @@ main = do
1415 tcounts <- runTestTT (TestList tests)
1516 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
1617 where
17− tests = relationOptTests ++ databaseOptTests
18+ tests = relationOptTests ++ databaseOptTests ++ [testTransitiveOptimization,
19+ testImpossiblePredicates]
1820 optDBCTest = map (\(name, expr, unopt) -> TestCase $ assertEqual name expr (evalState (applyStaticDatabaseOptimization unopt) (freshDatabaseState dateExamples)))
1921 relvar nam = RelationVariable nam ()
2022 startState = mkRelationalExprState dateExamples
@@ -22,9 +24,7 @@ main = do
2224 relationOptTests = optRelTest [
2325 ("StaticProject", Right $ relvar "s", Project (AttributeNames (attributeNames suppliersRel)) (relvar "s")),
2426 ("StaticUnion", Right $ relvar "s", Union (relvar "s") (relvar "s")),
25− ("StaticJoin", Right $ relvar "s", Join (relvar "s") (relvar "s")),
26− ("StaticRestrictTrue", Right $ relvar "s", Restrict TruePredicate (relvar "s")),
27− ("StaticRestrictFalse", Right $ MakeStaticRelation (attributes suppliersRel) emptyTupleSet, Restrict (NotPredicate TruePredicate) (relvar "s"))
27+ ("StaticJoin", Right $ relvar "s", Join (relvar "s") (relvar "s"))
2828 ]
2929 databaseOptTests = optDBCTest [
3030 ("StaticAssign",
@@ -37,3 +37,26 @@ main = do
3737 MultipleExpr [Assign "z" (Restrict TruePredicate (relvar "s")),
3838 Assign "z" (Restrict TruePredicate (relvar "s"))])
3939 ]
40+
41+testTransitiveOptimization :: Test
42+testTransitiveOptimization = TestCase $ do
43+ let expr atomexpr = AndPredicate (AttributeEqualityPredicate "a" (NakedAtomExpr (IntegerAtom 300))) (AttributeEqualityPredicate "b" atomexpr)
44+ exprIn = expr (AttributeAtomExpr "a")
45+ exprOut = expr (NakedAtomExpr (IntegerAtom 300))
46+ assertEqual "transitive property" (Right exprOut) (runReader (applyStaticPredicateOptimization exprIn) (RelationalExprStateElems dateExamples))
47+
48+optRelExpr :: RelationalExpr -> Either RelationalError RelationalExpr
49+optRelExpr expr = runReader (applyStaticRelationalOptimization expr) (RelationalExprStateElems dateExamples)
50+
51+testImpossiblePredicates :: Test
52+testImpossiblePredicates = TestCase $ do
53+ let tautTrue = Restrict (AtomExprPredicate (NakedAtomExpr (BoolAtom True))) rel
54+ tautTrue2 = Restrict TruePredicate rel
55+ tautFalse = Restrict (AtomExprPredicate (NakedAtomExpr (BoolAtom False))) rel
56+ tautFalse2 = Restrict (NotPredicate TruePredicate) rel
57+ emptyRel = MakeStaticRelation (attributes suppliersRel) emptyTupleSet
58+ rel = RelationVariable "s" ()
59+ assertEqual "remove tautology where true" (Right rel) (optRelExpr tautTrue)
60+ assertEqual "remove tautology where true2" (Right rel) (optRelExpr tautTrue2)
61+ assertEqual "remove tautology where false" (Right emptyRel) (optRelExpr tautFalse)
62+ assertEqual "remove tautology where false2" (Right emptyRel) (optRelExpr tautFalse2)