1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-13 19:49:20 +03:00
juvix/test/TypeCheck/Negative.hs
2022-04-04 19:11:26 +02:00

80 lines
2.4 KiB
Haskell

module TypeCheck.Negative (allTests) where
import Base
import MiniJuvix.Syntax.MicroJuvix.Error
import qualified MiniJuvix.Syntax.MicroJuvix.TypeChecker as T
import qualified MiniJuvix.Translation.AbstractToMicroJuvix as A
type FailMsg = String
data NegTest = NegTest
{ name :: String,
relDir :: FilePath,
file :: FilePath,
checkErr :: [TypeCheckerError] -> Maybe FailMsg }
testDescr :: NegTest -> TestDescr
testDescr NegTest {..} = TestDescr {
testName = name,
testRoot = root </> relDir,
testAssertion = Single $ do
result <- parseModuleIO file
>>= scopeModuleIO
>>= translateModuleIO
>>| A.translateModule
>>| T.checkModule
case result of
Left es -> whenJust (checkErr (toList es)) assertFailure
Right _ -> assertFailure "The type checker did not find an error."
}
allTests :: TestTree
allTests = testGroup "TypeCheck negative tests"
(map (mkTest . testDescr) tests)
root :: FilePath
root = "tests/negative"
wrongError :: Maybe FailMsg
wrongError = Just "Incorrect error"
tests :: [NegTest]
tests = [
NegTest "Constructor in pattern type error" "MicroJuvix"
"PatternConstructor.mjuvix" $ \case
[ErrWrongConstructorType {}] -> Nothing
_ -> wrongError
, NegTest "Constructor pattern length mismatch" "MicroJuvix"
"PatternConstructorApp.mjuvix" $ \case
[ErrWrongConstructorAppArgs {}] -> Nothing
_ -> wrongError
, NegTest "Type vs inferred type mismatch" "MicroJuvix"
"WrongType.mjuvix" $ \case
[ErrWrongType {}] -> Nothing
_ -> wrongError
, NegTest "literal string vs inferred type mismatch" "MicroJuvix"
"WrongTypeLiteralString.mjuvix" $ \case
[ErrWrongType {}] -> Nothing
_ -> wrongError
, NegTest "literal int vs inferred type mismatch" "MicroJuvix"
"WrongTypeLiteralInt.mjuvix" $ \case
[ErrWrongType {}] -> Nothing
_ -> wrongError
, NegTest "Function application with non-function type" "MicroJuvix"
"ExpectedFunctionType.mjuvix" $ \case
[ErrExpectedFunctionType {}] -> Nothing
_ -> wrongError
, NegTest "Function definition clause with two many match patterns" "MicroJuvix"
"TooManyPatterns.mjuvix" $ \case
[ErrTooManyPatterns {}] -> Nothing
_ -> wrongError
, NegTest "Multiple type errors are captured" "MicroJuvix"
"MultiWrongType.mjuvix" $ \case
[ErrWrongType {},
ErrWrongType {}] -> Nothing
_ -> wrongError
]