module Database.Narc.Test where
import Prelude hiding (catch)
import Control.Monad.Error ( runErrorT)
import Test.QuickCheck hiding (promote, Failure)
import Test.HUnit hiding (State, assert)
import Unary
import Gensym
import QCUtils
import Database.Narc.AST
import Database.Narc.Compile
import Database.Narc.Failure
import qualified Database.Narc.SQL as SQL
import Database.Narc.Type as Type
import Database.Narc.TypeInfer
import Database.Narc.TermGen
normalizerTests :: Test
normalizerTests =
TestList [
TestCase $ unitAssert $
let term = (Comp "x" (Table "foo" [("fop", TNum)], ())
(If (Bool True,())
(Singleton (Record
[("f0", (Project (Var "x", ())
"fop",()))],()),())
(Singleton (Record
[("f0", (Num 3, ()))], ()), ()),
()), ()) in
let typedTerm = runErrorGensym $ infer $ term in
(1::Integer) < (SQL.sizeQuery $ compile [] $ typedTerm)
]
unitTests :: Test
unitTests = TestList [tyCheckTests, normalizerTests, typingTest]
runUnitTests :: IO Counts
runUnitTests = runTestTT $ unitTests
prop_compile_safe :: Property
prop_compile_safe =
forAll dbTableTypeGen $ \ty ->
forAll (sized (closedTypedTermGen ty)) $ \m ->
case tryErrorGensym (infer m) of
Left _ -> label "ill-typed" $ property True
Right (m'@(_, ty)) ->
classify (isDBTableTy ty) "Flat relation type" $
let q = (compile [] $! m') in
collect (min 100 (SQL.sizeQuery q::Unary)) $
excAsFalse (q == q)
prop_typedTermGen_tyCheck :: Property
prop_typedTermGen_tyCheck =
forAll (sized $ typeGen []) $ \ty ->
forAll (sized $ typedTermGen [] ty) $ \m ->
case runGensym $ runErrorT $ infer m of
Left _ -> False
Right (_m', ty') -> isErrorMSuccess $ unify ty ty'
main :: IO ()
main = do
quickCheckWith tinyArgs prop_typedTermGen_tyCheck
quickCheckWith tinyArgs prop_compile_safe
_ <- runUnitTests
return ()