module Test.IntegrationTest (tests) where
import Control.Monad (when)
import System.FilePath
import Base.CompilerError
import Base.TrackedErrors
import Parser.Common
import Parser.IntegrationTest ()
import Parser.TextParser
import Test.Common
import Types.DefinedCategory
import Types.IntegrationTest
import Types.TypeCategory
tests :: [IO (TrackedErrors ())]
tests :: [IO (TrackedErrors ())]
tests = [
String
-> (IntegrationTest SourceContext -> TrackedErrors ())
-> IO (TrackedErrors ())
checkFileContents
(String
"testfiles" String -> String -> String
</> String
"basic_compiles_test.0rt")
(\IntegrationTest SourceContext
t -> do
let h :: IntegrationTestHeader SourceContext
h = IntegrationTest SourceContext
-> IntegrationTestHeader SourceContext
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourceContext
t
Bool -> TrackedErrors () -> TrackedErrors ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ExpectedResult SourceContext -> Bool
forall c. ExpectedResult c -> Bool
isExpectCompiles (ExpectedResult SourceContext -> Bool)
-> ExpectedResult SourceContext -> Bool
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult IntegrationTestHeader SourceContext
h) (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ String -> TrackedErrors ()
forall a. String -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"Expected ExpectCompiles"
String -> String -> TrackedErrors ()
forall a. (Eq a, Show a) => a -> a -> TrackedErrors ()
checkEquals (IntegrationTestHeader SourceContext -> String
forall c. IntegrationTestHeader c -> String
ithTestName IntegrationTestHeader SourceContext
h) String
"basic compiles test"
[String] -> [String] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (IntegrationTestHeader SourceContext -> [String]
forall c. IntegrationTestHeader c -> [String]
ithArgs IntegrationTestHeader SourceContext
h) []
Maybe Integer -> Maybe Integer -> TrackedErrors ()
forall a. (Eq a, Show a) => a -> a -> TrackedErrors ()
checkEquals (IntegrationTestHeader SourceContext -> Maybe Integer
forall c. IntegrationTestHeader c -> Maybe Integer
ithTimeout IntegrationTestHeader SourceContext
h) Maybe Integer
forall a. Maybe a
Nothing
[OutputPattern] -> [OutputPattern] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (ExpectedResult SourceContext -> [OutputPattern]
forall c. ExpectedResult c -> [OutputPattern]
getRequirePattern (ExpectedResult SourceContext -> [OutputPattern])
-> ExpectedResult SourceContext -> [OutputPattern]
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult IntegrationTestHeader SourceContext
h) [
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputCompiler String
"pattern in output 1",
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputAny String
"pattern in output 2"
]
[OutputPattern] -> [OutputPattern] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (ExpectedResult SourceContext -> [OutputPattern]
forall c. ExpectedResult c -> [OutputPattern]
getExcludePattern (ExpectedResult SourceContext -> [OutputPattern])
-> ExpectedResult SourceContext -> [OutputPattern]
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult IntegrationTestHeader SourceContext
h) [
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputStderr String
"pattern not in output 1",
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputStdout String
"pattern not in output 2"
]
[String] -> [String] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (IntegrationTest SourceContext -> [String]
forall c. IntegrationTest c -> [String]
extractCategoryNames IntegrationTest SourceContext
t) [String
"Test"]
[String] -> [String] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (IntegrationTest SourceContext -> [String]
forall c. IntegrationTest c -> [String]
extractDefinitionNames IntegrationTest SourceContext
t) [String
"Test"]
),
String
-> (IntegrationTest SourceContext -> TrackedErrors ())
-> IO (TrackedErrors ())
checkFileContents
(String
"testfiles" String -> String -> String
</> String
"basic_error_test.0rt")
(\IntegrationTest SourceContext
t -> do
let h :: IntegrationTestHeader SourceContext
h = IntegrationTest SourceContext
-> IntegrationTestHeader SourceContext
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourceContext
t
Bool -> TrackedErrors () -> TrackedErrors ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ExpectedResult SourceContext -> Bool
forall c. ExpectedResult c -> Bool
isExpectCompilerError (ExpectedResult SourceContext -> Bool)
-> ExpectedResult SourceContext -> Bool
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult IntegrationTestHeader SourceContext
h) (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ String -> TrackedErrors ()
forall a. String -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"Expected ExpectCompilerError"
String -> String -> TrackedErrors ()
forall a. (Eq a, Show a) => a -> a -> TrackedErrors ()
checkEquals (IntegrationTestHeader SourceContext -> String
forall c. IntegrationTestHeader c -> String
ithTestName IntegrationTestHeader SourceContext
h) String
"basic error test"
[String] -> [String] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (IntegrationTestHeader SourceContext -> [String]
forall c. IntegrationTestHeader c -> [String]
ithArgs IntegrationTestHeader SourceContext
h) []
Maybe Integer -> Maybe Integer -> TrackedErrors ()
forall a. (Eq a, Show a) => a -> a -> TrackedErrors ()
checkEquals (IntegrationTestHeader SourceContext -> Maybe Integer
forall c. IntegrationTestHeader c -> Maybe Integer
ithTimeout IntegrationTestHeader SourceContext
h) Maybe Integer
forall a. Maybe a
Nothing
[OutputPattern] -> [OutputPattern] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (ExpectedResult SourceContext -> [OutputPattern]
forall c. ExpectedResult c -> [OutputPattern]
getRequirePattern (ExpectedResult SourceContext -> [OutputPattern])
-> ExpectedResult SourceContext -> [OutputPattern]
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult IntegrationTestHeader SourceContext
h) [
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputCompiler String
"pattern in output 1",
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputAny String
"pattern in output 2"
]
[OutputPattern] -> [OutputPattern] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (ExpectedResult SourceContext -> [OutputPattern]
forall c. ExpectedResult c -> [OutputPattern]
getExcludePattern (ExpectedResult SourceContext -> [OutputPattern])
-> ExpectedResult SourceContext -> [OutputPattern]
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult IntegrationTestHeader SourceContext
h) [
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputStderr String
"pattern not in output 1",
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputStdout String
"pattern not in output 2"
]
[String] -> [String] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (IntegrationTest SourceContext -> [String]
forall c. IntegrationTest c -> [String]
extractCategoryNames IntegrationTest SourceContext
t) [String
"Test"]
[String] -> [String] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (IntegrationTest SourceContext -> [String]
forall c. IntegrationTest c -> [String]
extractDefinitionNames IntegrationTest SourceContext
t) [String
"Test"]
),
String
-> (IntegrationTest SourceContext -> TrackedErrors ())
-> IO (TrackedErrors ())
checkFileContents
(String
"testfiles" String -> String -> String
</> String
"basic_crash_test.0rt")
(\IntegrationTest SourceContext
t -> do
let h :: IntegrationTestHeader SourceContext
h = IntegrationTest SourceContext
-> IntegrationTestHeader SourceContext
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourceContext
t
Bool -> TrackedErrors () -> TrackedErrors ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ExpectedResult SourceContext -> Bool
forall c. ExpectedResult c -> Bool
isExpectRuntimeError (ExpectedResult SourceContext -> Bool)
-> ExpectedResult SourceContext -> Bool
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult IntegrationTestHeader SourceContext
h) (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ String -> TrackedErrors ()
forall a. String -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"Expected ExpectRuntimeError"
[String] -> [String] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (IntegrationTestHeader SourceContext -> [String]
forall c. IntegrationTestHeader c -> [String]
ithArgs IntegrationTestHeader SourceContext
h) [String
"arg1",String
"arg2",String
"arg3"]
Maybe Integer -> Maybe Integer -> TrackedErrors ()
forall a. (Eq a, Show a) => a -> a -> TrackedErrors ()
checkEquals (IntegrationTestHeader SourceContext -> Maybe Integer
forall c. IntegrationTestHeader c -> Maybe Integer
ithTimeout IntegrationTestHeader SourceContext
h) (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
10)
[OutputPattern] -> [OutputPattern] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (ExpectedResult SourceContext -> [OutputPattern]
forall c. ExpectedResult c -> [OutputPattern]
getRequirePattern (ExpectedResult SourceContext -> [OutputPattern])
-> ExpectedResult SourceContext -> [OutputPattern]
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult IntegrationTestHeader SourceContext
h) [
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputAny String
"pattern in output 1",
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputAny String
"pattern in output 2"
]
[OutputPattern] -> [OutputPattern] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (ExpectedResult SourceContext -> [OutputPattern]
forall c. ExpectedResult c -> [OutputPattern]
getExcludePattern (ExpectedResult SourceContext -> [OutputPattern])
-> ExpectedResult SourceContext -> [OutputPattern]
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult IntegrationTestHeader SourceContext
h) [
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputAny String
"pattern not in output 1",
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputAny String
"pattern not in output 2"
]
[String] -> [String] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (IntegrationTest SourceContext -> [String]
forall c. IntegrationTest c -> [String]
extractCategoryNames IntegrationTest SourceContext
t) [String
"Test"]
[String] -> [String] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (IntegrationTest SourceContext -> [String]
forall c. IntegrationTest c -> [String]
extractDefinitionNames IntegrationTest SourceContext
t) [String
"Test"]
),
String
-> (IntegrationTest SourceContext -> TrackedErrors ())
-> IO (TrackedErrors ())
checkFileContents
(String
"testfiles" String -> String -> String
</> String
"basic_success_test.0rt")
(\IntegrationTest SourceContext
t -> do
let h :: IntegrationTestHeader SourceContext
h = IntegrationTest SourceContext
-> IntegrationTestHeader SourceContext
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourceContext
t
Bool -> TrackedErrors () -> TrackedErrors ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ExpectedResult SourceContext -> Bool
forall c. ExpectedResult c -> Bool
isExpectRuntimeSuccess (ExpectedResult SourceContext -> Bool)
-> ExpectedResult SourceContext -> Bool
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult IntegrationTestHeader SourceContext
h) (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ String -> TrackedErrors ()
forall a. String -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"Expected ExpectRuntimeSuccess"
String -> String -> TrackedErrors ()
forall a. (Eq a, Show a) => a -> a -> TrackedErrors ()
checkEquals (IntegrationTestHeader SourceContext -> String
forall c. IntegrationTestHeader c -> String
ithTestName IntegrationTestHeader SourceContext
h) String
"basic success test"
[String] -> [String] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (IntegrationTestHeader SourceContext -> [String]
forall c. IntegrationTestHeader c -> [String]
ithArgs IntegrationTestHeader SourceContext
h) []
Maybe Integer -> Maybe Integer -> TrackedErrors ()
forall a. (Eq a, Show a) => a -> a -> TrackedErrors ()
checkEquals (IntegrationTestHeader SourceContext -> Maybe Integer
forall c. IntegrationTestHeader c -> Maybe Integer
ithTimeout IntegrationTestHeader SourceContext
h) (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0)
[OutputPattern] -> [OutputPattern] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (ExpectedResult SourceContext -> [OutputPattern]
forall c. ExpectedResult c -> [OutputPattern]
getRequirePattern (ExpectedResult SourceContext -> [OutputPattern])
-> ExpectedResult SourceContext -> [OutputPattern]
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult IntegrationTestHeader SourceContext
h) [
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputAny String
"pattern in output 1",
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputAny String
"pattern in output 2"
]
[OutputPattern] -> [OutputPattern] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (ExpectedResult SourceContext -> [OutputPattern]
forall c. ExpectedResult c -> [OutputPattern]
getExcludePattern (ExpectedResult SourceContext -> [OutputPattern])
-> ExpectedResult SourceContext -> [OutputPattern]
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult IntegrationTestHeader SourceContext
h) [
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputAny String
"pattern not in output 1",
OutputScope -> String -> OutputPattern
OutputPattern OutputScope
OutputAny String
"pattern not in output 2"
]
[String] -> [String] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (IntegrationTest SourceContext -> [String]
forall c. IntegrationTest c -> [String]
extractCategoryNames IntegrationTest SourceContext
t) [String
"Test"]
[String] -> [String] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly (IntegrationTest SourceContext -> [String]
forall c. IntegrationTest c -> [String]
extractDefinitionNames IntegrationTest SourceContext
t) [String
"Test"]
)
]
checkFileContents ::
String -> (IntegrationTest SourceContext -> TrackedErrors ()) -> IO (TrackedErrors ())
checkFileContents :: String
-> (IntegrationTest SourceContext -> TrackedErrors ())
-> IO (TrackedErrors ())
checkFileContents String
f IntegrationTest SourceContext -> TrackedErrors ()
o = TrackedErrorsT IO () -> IO (TrackedErrors ())
forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m (TrackedErrors a)
toTrackedErrors (TrackedErrorsT IO () -> IO (TrackedErrors ()))
-> TrackedErrorsT IO () -> IO (TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ do
String
s <- IO String -> TrackedErrorsT IO String
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO String -> TrackedErrorsT IO String)
-> IO String -> TrackedErrorsT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
loadFile String
f
IntegrationTest SourceContext
t <- TextParser (IntegrationTest SourceContext)
-> String
-> String
-> TrackedErrorsT IO (IntegrationTest SourceContext)
forall (m :: * -> *) a.
ErrorContextM m =>
TextParser a -> String -> String -> m a
runTextParser (ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
-> TextParser (IntegrationTest SourceContext)
-> TextParser (IntegrationTest SourceContext)
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ParsecT CompilerMessage String Identity ()
optionalSpace ParsecT CompilerMessage String Identity ()
endOfDoc TextParser (IntegrationTest SourceContext)
forall a. ParseFromSource a => TextParser a
sourceParser) String
f String
s
TrackedErrors () -> TrackedErrorsT IO ()
forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m a
fromTrackedErrors (TrackedErrors () -> TrackedErrorsT IO ())
-> TrackedErrors () -> TrackedErrorsT IO ()
forall a b. (a -> b) -> a -> b
$ IntegrationTest SourceContext -> TrackedErrors ()
o IntegrationTest SourceContext
t TrackedErrors () -> String -> TrackedErrors ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!! String
"Check " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
extractCategoryNames :: IntegrationTest c -> [String]
= (AnyCategory c -> String) -> [AnyCategory c] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (CategoryName -> String
forall a. Show a => a -> String
show (CategoryName -> String)
-> (AnyCategory c -> CategoryName) -> AnyCategory c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName) ([AnyCategory c] -> [String])
-> (IntegrationTest c -> [AnyCategory c])
-> IntegrationTest c
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntegrationTest c -> [AnyCategory c]
forall c. IntegrationTest c -> [AnyCategory c]
itCategory
extractDefinitionNames :: IntegrationTest c -> [String]
= (DefinedCategory c -> String) -> [DefinedCategory c] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (CategoryName -> String
forall a. Show a => a -> String
show (CategoryName -> String)
-> (DefinedCategory c -> CategoryName)
-> DefinedCategory c
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName) ([DefinedCategory c] -> [String])
-> (IntegrationTest c -> [DefinedCategory c])
-> IntegrationTest c
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntegrationTest c -> [DefinedCategory c]
forall c. IntegrationTest c -> [DefinedCategory c]
itDefinition