1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-14 17:32:00 +03:00
juvix/test/Termination/Negative.hs
Jan Mas Rovira 34719bbc4d
Report termination errors after typechecking (#2318)
- Closes #2293.
- Closes #2319 

I've added an effect for termination. It keeps track of which functions
failed the termination checker, which is run just after translating to
Internal. During typechecking, non-terminating functions are not
normalized. After typechecking, if there is at least one function which
failed the termination checker, an error is reported.
Additionally, we now properly check for termination of functions defined
in a let expression in the repl.
2023-08-30 16:38:59 +02:00

85 lines
2.4 KiB
Haskell

module Termination.Negative (module Termination.Negative) where
import Base
import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination
type FailMsg = String
data NegTest = NegTest
{ _name :: String,
_relDir :: Path Rel Dir,
_file :: Path Rel File,
_checkErr :: TerminationError -> Maybe FailMsg
}
testDescr :: NegTest -> TestDescr
testDescr NegTest {..} =
let tRoot = root <//> _relDir
file' = tRoot <//> _file
in TestDescr
{ _testName = _name,
_testRoot = tRoot,
_testAssertion = Single $ do
entryPoint <- set entryPointNoStdlib True <$> defaultEntryPointCwdIO file'
result <- runIOEither entryPoint upToInternalTyped
case mapLeft fromJuvixError result of
Left (Just lexError) -> whenJust (_checkErr lexError) assertFailure
Left Nothing -> assertFailure "The termination checker did not find an error."
Right _ -> assertFailure "An error ocurred but it was not by the termination checker."
}
allTests :: TestTree
allTests =
testGroup
"Termination negative tests"
(map (mkTest . testDescr) tests)
root :: Path Abs Dir
root = relToProject $(mkRelDir "tests/negative/Termination")
tests :: [NegTest]
tests =
[ NegTest
"Mutual recursive functions non terminating"
$(mkRelDir ".")
$(mkRelFile "Mutual.juvix")
$ \case
ErrNoLexOrder {} -> Nothing,
NegTest
"Another mutual block non terminating"
$(mkRelDir ".")
$(mkRelFile "Ord.juvix")
$ \case
ErrNoLexOrder {} -> Nothing,
NegTest
"Only one function, f, marked terminating in a mutual block"
$(mkRelDir ".")
$(mkRelFile "TerminatingF.juvix")
$ \case
ErrNoLexOrder {} -> Nothing,
NegTest
"Only one function, g, marked terminating in a mutual block"
$(mkRelDir ".")
$(mkRelFile "TerminatingG.juvix")
$ \case
ErrNoLexOrder {} -> Nothing,
NegTest
"Tree"
$(mkRelDir ".")
$(mkRelFile "Data/Tree.juvix")
$ \case
ErrNoLexOrder {} -> Nothing,
NegTest
"Quicksort is not terminating"
$(mkRelDir ".")
$(mkRelFile "Data/QuickSort.juvix")
$ \case
ErrNoLexOrder {} -> Nothing,
NegTest
"Loop in axiom type"
$(mkRelDir ".")
$(mkRelFile "Axiom.juvix")
$ \case
ErrNoLexOrder {} -> Nothing
]