1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-17 11:51:42 +03:00
juvix/test/Reachability/Positive.hs
Jonathan Cubides 01a44e436d
Refactor (#1420)
* Big refactor in process

* remove unnecessary functions from the prelude

* remove comments
2022-08-03 13:20:40 +02:00

96 lines
2.9 KiB
Haskell

module Reachability.Positive where
import Base
import Data.HashSet qualified as HashSet
import Juvix.Compiler.Internal.Language qualified as Micro
import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Data.Context qualified as Micro
import Juvix.Compiler.Pipeline
data PosTest = PosTest
{ _name :: String,
_relDir :: FilePath,
_stdlibMode :: StdlibMode,
_file :: FilePath,
_reachable :: HashSet String
}
makeLenses ''PosTest
root :: FilePath
root = "tests/positive"
testDescr :: PosTest -> TestDescr
testDescr PosTest {..} =
let tRoot = root </> _relDir
in TestDescr
{ _testName = _name,
_testRoot = tRoot,
_testAssertion = Steps $ \step -> do
cwd <- getCurrentDirectory
entryFile <- canonicalizePath _file
let noStdlib = _stdlibMode == StdlibExclude
entryPoint =
EntryPoint
{ _entryPointRoot = cwd,
_entryPointNoTermination = False,
_entryPointNoPositivity = False,
_entryPointPackage = emptyPackage,
_entryPointNoStdlib = noStdlib,
_entryPointModulePaths = pure entryFile
}
step "Pipeline up to reachability"
p :: Micro.InternalTypedResult <- runIO (upToInternalReachability entryPoint)
step "Check reachability results"
let names = concatMap getNames (p ^. Micro.resultModules)
mapM_ check names
}
where
check n = assertBool ("unreachable not filtered: " ++ unpack n) (HashSet.member (unpack n) _reachable)
getNames :: Micro.Module -> [Text]
getNames m = concatMap getDeclName (m ^. (Micro.moduleBody . Micro.moduleStatements))
where
getDeclName :: Micro.Statement -> [Text]
getDeclName = \case
Micro.StatementInductive i -> [i ^. (Micro.inductiveName . Micro.nameText)]
Micro.StatementFunction f -> [f ^. (Micro.funDefName . Micro.nameText)]
Micro.StatementForeign {} -> []
Micro.StatementAxiom ax -> [ax ^. (Micro.axiomName . Micro.nameText)]
Micro.StatementInclude i -> getNames (i ^. Micro.includeModule)
allTests :: TestTree
allTests =
testGroup
"Reachability positive tests"
(map (mkTest . testDescr) tests)
tests :: [PosTest]
tests =
[ PosTest
"Reachability with modules"
"Reachability"
StdlibInclude
"M.juvix"
( HashSet.fromList
["f", "g", "h", "Bool", "Maybe"]
),
PosTest
"Reachability with modules and standard library"
"Reachability"
StdlibInclude
"N.juvix"
( HashSet.fromList
["test", "Unit"]
),
PosTest
"Reachability with public imports"
"Reachability"
StdlibInclude
"O.juvix"
( HashSet.fromList
["f", "g", "h", "k", "Bool", "Maybe"]
)
]