{-# LANGUAGE Safe #-}
module Test.IntegrationTest (tests) where
import Control.Monad (when)
import System.FilePath
import Text.Parsec
import Base.CompileError
import Base.CompileInfo
import Parser.Common
import Parser.IntegrationTest ()
import Test.Common
import Types.DefinedCategory
import Types.IntegrationTest
import Types.Positional
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance
tests :: [IO (CompileInfo ())]
tests = [
checkFileContents
("testfiles" </> "basic_error_test.0rt")
(\t -> return $ do
let h = itHeader t
when (not $ isExpectCompileError $ ithResult h) $ compileErrorM "Expected ExpectCompileError"
checkEquals (ithTestName h) "basic error test"
containsExactly (getRequirePattern $ ithResult h) [
OutputPattern OutputCompiler "pattern in output 1",
OutputPattern OutputAny "pattern in output 2"
]
containsExactly (getExcludePattern $ ithResult h) [
OutputPattern OutputStderr "pattern not in output 1",
OutputPattern OutputStdout "pattern not in output 2"
]
containsExactly (extractCategoryNames t) ["Test"]
containsExactly (extractDefinitionNames t) ["Test"]
),
checkFileContents
("testfiles" </> "basic_crash_test.0rt")
(\t -> return $ do
let h = itHeader t
when (not $ isExpectRuntimeError $ ithResult h) $ compileErrorM "Expected ExpectRuntimeError"
checkEquals (ithTestName h) "basic crash test"
let match = case ereExpression $ ithResult h of
(Expression _
(TypeCall _
(JustTypeInstance (TypeInstance (CategoryName "Test") (Positional [])))
(FunctionCall _ (FunctionName "execute") (Positional []) (Positional []))) []) -> True
_ -> False
when (not match) $ compileErrorM "Expected test expression \"Test$execute()\""
containsExactly (getRequirePattern $ ithResult h) [
OutputPattern OutputAny "pattern in output 1",
OutputPattern OutputAny "pattern in output 2"
]
containsExactly (getExcludePattern $ ithResult h) [
OutputPattern OutputAny "pattern not in output 1",
OutputPattern OutputAny "pattern not in output 2"
]
containsExactly (extractCategoryNames t) ["Test"]
containsExactly (extractDefinitionNames t) ["Test"]
),
checkFileContents
("testfiles" </> "basic_success_test.0rt")
(\t -> return $ do
let h = itHeader t
when (not $ isExpectRuntimeSuccess $ ithResult h) $ compileErrorM "Expected ExpectRuntimeSuccess"
checkEquals (ithTestName h) "basic success test"
let match = case ersExpression $ ithResult h of
(Expression _
(TypeCall _
(JustTypeInstance (TypeInstance (CategoryName "Test") (Positional [])))
(FunctionCall _ (FunctionName "execute") (Positional []) (Positional []))) []) -> True
_ -> False
when (not match) $ compileErrorM "Expected test expression \"Test$execute()\""
containsExactly (getRequirePattern $ ithResult h) [
OutputPattern OutputAny "pattern in output 1",
OutputPattern OutputAny "pattern in output 2"
]
containsExactly (getExcludePattern $ ithResult h) [
OutputPattern OutputAny "pattern not in output 1",
OutputPattern OutputAny "pattern not in output 2"
]
containsExactly (extractCategoryNames t) ["Test"]
containsExactly (extractDefinitionNames t) ["Test"]
)
]
checkFileContents ::
String -> (IntegrationTest SourcePos -> IO (CompileInfo ())) -> IO (CompileInfo ())
checkFileContents f o = do
s <- loadFile f
unwrap $ parse (between optionalSpace endOfDoc sourceParser) f s
where
unwrap (Left e) = return $ compileErrorM (show e)
unwrap (Right t) = fmap (("Check " ++ f ++ ":") ??>) $ o t
extractCategoryNames :: IntegrationTest c -> [String]
extractCategoryNames = map (show . getCategoryName) . itCategory
extractDefinitionNames :: IntegrationTest c -> [String]
extractDefinitionNames = map (show . dcName) . itDefinition