mirror of
https://github.com/anoma/juvix.git
synced 2024-12-17 11:51:42 +03:00
01a44e436d
* Big refactor in process * remove unnecessary functions from the prelude * remove comments
96 lines
2.9 KiB
Haskell
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"]
|
|
)
|
|
]
|