mirror of
https://github.com/anoma/juvix.git
synced 2024-12-15 01:52:11 +03:00
214 lines
5.3 KiB
Haskell
214 lines
5.3 KiB
Haskell
module Scope.Negative (allTests) where
|
|
|
|
import Base
|
|
import MiniJuvix.Pipeline
|
|
import MiniJuvix.Syntax.Concrete.Scoped.Error
|
|
|
|
type FailMsg = String
|
|
|
|
data NegTest = NegTest
|
|
{ _name :: String,
|
|
_relDir :: FilePath,
|
|
_file :: FilePath,
|
|
_checkErr :: ScoperError -> Maybe FailMsg
|
|
}
|
|
|
|
root :: FilePath
|
|
root = "tests/negative"
|
|
|
|
testDescr :: NegTest -> TestDescr
|
|
testDescr NegTest {..} =
|
|
let tRoot = root </> _relDir
|
|
in TestDescr
|
|
{ _testName = _name,
|
|
_testRoot = tRoot,
|
|
_testAssertion = Single $ do
|
|
let entryPoint = defaultEntryPoint _file
|
|
res <- runIOEither (upToAbstract entryPoint)
|
|
case mapLeft fromMiniJuvixError res of
|
|
Left (Just err) -> whenJust (_checkErr err) assertFailure
|
|
Left Nothing -> assertFailure "The scope checker did not find an error."
|
|
Right _ -> assertFailure "An error ocurred but it was not in the scoper."
|
|
}
|
|
|
|
allTests :: TestTree
|
|
allTests =
|
|
testGroup
|
|
"Scope negative tests"
|
|
(map (mkTest . testDescr) tests)
|
|
|
|
wrongError :: Maybe FailMsg
|
|
wrongError = Just "Incorrect error"
|
|
|
|
tests :: [NegTest]
|
|
tests =
|
|
[ NegTest
|
|
"Not in scope"
|
|
"."
|
|
"NotInScope.mjuvix"
|
|
$ \case
|
|
ErrSymNotInScope {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Qualified not in scope"
|
|
"."
|
|
"QualSymNotInScope.mjuvix"
|
|
$ \case
|
|
ErrQualSymNotInScope {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Multiple declarations"
|
|
"."
|
|
"MultipleDeclarations.mjuvix"
|
|
$ \case
|
|
ErrMultipleDeclarations {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Import cycle"
|
|
"ImportCycle"
|
|
"A.mjuvix"
|
|
$ \case
|
|
ErrImportCycle {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Binding group conflict (function clause)"
|
|
"BindGroupConflict"
|
|
"Clause.mjuvix"
|
|
$ \case
|
|
ErrBindGroup {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Binding group conflict (lambda clause)"
|
|
"BindGroupConflict"
|
|
"Lambda.mjuvix"
|
|
$ \case
|
|
ErrBindGroup {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Infix error (expression)"
|
|
"."
|
|
"InfixError.mjuvix"
|
|
$ \case
|
|
ErrInfixParser {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Infix error (pattern)"
|
|
"."
|
|
"InfixErrorP.mjuvix"
|
|
$ \case
|
|
ErrInfixPattern {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Duplicate fixity declaration"
|
|
"."
|
|
"DuplicateFixity.mjuvix"
|
|
$ \case
|
|
ErrDuplicateFixity {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Multiple export conflict"
|
|
"."
|
|
"MultipleExportConflict.mjuvix"
|
|
$ \case
|
|
ErrMultipleExport {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Module not in scope"
|
|
"."
|
|
"ModuleNotInScope.mjuvix"
|
|
$ \case
|
|
ErrModuleNotInScope {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Unused operator syntax definition"
|
|
"."
|
|
"UnusedOperatorDef.mjuvix"
|
|
$ \case
|
|
ErrUnusedOperatorDef {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Ambiguous symbol"
|
|
"."
|
|
"AmbiguousSymbol.mjuvix"
|
|
$ \case
|
|
ErrAmbiguousSym {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Lacks function clause"
|
|
"."
|
|
"LacksFunctionClause.mjuvix"
|
|
$ \case
|
|
ErrLacksFunctionClause {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Incorrect top module path"
|
|
"."
|
|
"WrongModuleName.mjuvix"
|
|
$ \case
|
|
ErrWrongTopModuleName {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Ambiguous export"
|
|
"."
|
|
"AmbiguousExport.mjuvix"
|
|
$ \case
|
|
ErrMultipleExport {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Ambiguous nested modules"
|
|
"."
|
|
"AmbiguousModule.mjuvix"
|
|
$ \case
|
|
ErrAmbiguousModuleSym {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Ambiguous nested constructors"
|
|
"."
|
|
"AmbiguousConstructor.mjuvix"
|
|
$ \case
|
|
ErrAmbiguousSym {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Wrong location of a compile block"
|
|
"CompileBlocks"
|
|
"WrongLocationCompileBlock.mjuvix"
|
|
$ \case
|
|
ErrWrongLocationCompileBlock {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Implicit argument on the left of an application"
|
|
"."
|
|
"AppLeftImplicit.mjuvix"
|
|
$ \case
|
|
ErrAppLeftImplicit {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Multiple compile blocks for the same name"
|
|
"CompileBlocks"
|
|
"MultipleCompileBlockSameName.mjuvix"
|
|
$ \case
|
|
ErrMultipleCompileBlockSameName {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Multiple rules for a backend inside a compile block"
|
|
"CompileBlocks"
|
|
"MultipleCompileRuleSameBackend.mjuvix"
|
|
$ \case
|
|
ErrMultipleCompileRuleSameBackend {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"issue 230"
|
|
"230"
|
|
"Prod.mjuvix"
|
|
$ \case
|
|
ErrQualSymNotInScope {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Compile block for a unsupported kind of expression"
|
|
"CompileBlocks"
|
|
"WrongKindExpressionCompileBlock.mjuvix"
|
|
$ \case
|
|
ErrWrongKindExpressionCompileBlock {} -> Nothing
|
|
_ -> wrongError
|
|
]
|