2022-05-30 14:40:52 +03:00
|
|
|
module Termination.Positive where
|
|
|
|
|
|
|
|
import Base
|
|
|
|
import Termination.Negative qualified as N
|
|
|
|
|
|
|
|
data PosTest = PosTest
|
|
|
|
{ _name :: String,
|
2022-12-20 15:05:40 +03:00
|
|
|
_relDir :: Path Rel Dir,
|
|
|
|
_file :: Path Rel File
|
2022-05-30 14:40:52 +03:00
|
|
|
}
|
|
|
|
|
2022-12-20 15:05:40 +03:00
|
|
|
root :: Path Abs Dir
|
|
|
|
root = relToProject $(mkRelDir "tests/positive/Termination")
|
2022-05-30 14:40:52 +03:00
|
|
|
|
|
|
|
testDescr :: PosTest -> TestDescr
|
|
|
|
testDescr PosTest {..} =
|
2022-12-20 15:05:40 +03:00
|
|
|
let tRoot = root <//> _relDir
|
|
|
|
file' = tRoot <//> _file
|
2022-05-30 14:40:52 +03:00
|
|
|
in TestDescr
|
|
|
|
{ _testName = _name,
|
|
|
|
_testRoot = tRoot,
|
|
|
|
_testAssertion = Single $ do
|
2023-04-13 12:27:39 +03:00
|
|
|
entryPoint <- set entryPointNoStdlib True <$> defaultEntryPointCwdIO file'
|
2023-08-30 17:38:59 +03:00
|
|
|
(void . runIO' entryPoint) upToInternalTyped
|
2022-05-30 14:40:52 +03:00
|
|
|
}
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- Testing --no-termination flag with all termination negative tests
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
2022-12-20 15:05:40 +03:00
|
|
|
rootNegTests :: Path Abs Dir
|
|
|
|
rootNegTests = relToProject $(mkRelDir "tests/negative/Termination")
|
2022-05-30 14:40:52 +03:00
|
|
|
|
|
|
|
testDescrFlag :: N.NegTest -> TestDescr
|
|
|
|
testDescrFlag N.NegTest {..} =
|
2022-12-20 15:05:40 +03:00
|
|
|
let tRoot = rootNegTests <//> _relDir
|
|
|
|
file' = tRoot <//> _file
|
2022-05-30 14:40:52 +03:00
|
|
|
in TestDescr
|
|
|
|
{ _testName = _name,
|
|
|
|
_testRoot = tRoot,
|
|
|
|
_testAssertion = Single $ do
|
2023-04-13 12:27:39 +03:00
|
|
|
entryPoint <-
|
|
|
|
set entryPointNoTermination True
|
|
|
|
. set entryPointNoStdlib True
|
|
|
|
<$> defaultEntryPointCwdIO file'
|
2023-08-30 17:38:59 +03:00
|
|
|
(void . runIO' entryPoint) upToInternalTyped
|
2022-05-30 14:40:52 +03:00
|
|
|
}
|
|
|
|
|
|
|
|
tests :: [PosTest]
|
|
|
|
tests =
|
2022-12-20 15:05:40 +03:00
|
|
|
[ PosTest
|
|
|
|
"Ackerman nice def. is terminating"
|
|
|
|
$(mkRelDir ".")
|
|
|
|
$(mkRelFile "Ack.juvix"),
|
|
|
|
PosTest
|
|
|
|
"Fibonacci with nested pattern"
|
|
|
|
$(mkRelDir ".")
|
|
|
|
$(mkRelFile "Fib.juvix"),
|
|
|
|
PosTest
|
|
|
|
"Recursive functions on Lists"
|
|
|
|
$(mkRelDir ".")
|
2023-01-31 19:54:18 +03:00
|
|
|
$(mkRelFile "Data/List.juvix"),
|
|
|
|
PosTest
|
|
|
|
"Recursive function on a tree"
|
|
|
|
$(mkRelDir ".")
|
2023-10-06 13:09:15 +03:00
|
|
|
$(mkRelFile "TreeGen.juvix"),
|
|
|
|
PosTest
|
|
|
|
"Ignore instance arguments"
|
|
|
|
$(mkRelDir ".")
|
|
|
|
$(mkRelFile "issue2414.juvix")
|
2022-05-30 14:40:52 +03:00
|
|
|
]
|
|
|
|
|
|
|
|
testsWithKeyword :: [PosTest]
|
|
|
|
testsWithKeyword =
|
2022-12-20 15:05:40 +03:00
|
|
|
[ PosTest
|
|
|
|
"terminating for all functions in the mutual block"
|
|
|
|
$(mkRelDir ".")
|
|
|
|
$(mkRelFile "Mutual.juvix"),
|
|
|
|
PosTest
|
|
|
|
"Undefined is terminating by assumption"
|
|
|
|
$(mkRelDir ".")
|
|
|
|
$(mkRelFile "Undefined.juvix")
|
2022-05-30 14:40:52 +03:00
|
|
|
]
|
|
|
|
|
|
|
|
negTests :: [N.NegTest]
|
|
|
|
negTests = N.tests
|
|
|
|
|
|
|
|
allTests :: TestTree
|
|
|
|
allTests =
|
|
|
|
testGroup
|
|
|
|
"Positive tests"
|
|
|
|
[ testGroup
|
|
|
|
"Well-known terminating functions"
|
|
|
|
(map (mkTest . testDescr) tests),
|
|
|
|
testGroup
|
2022-07-23 10:27:12 +03:00
|
|
|
"Bypass termination checking using --non-termination flag on negative tests"
|
2022-05-30 14:40:52 +03:00
|
|
|
(map (mkTest . testDescrFlag) negTests),
|
|
|
|
testGroup
|
|
|
|
"Terminating keyword"
|
|
|
|
(map (mkTest . testDescr) testsWithKeyword)
|
|
|
|
]
|