1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-15 01:52:11 +03:00
juvix/test/Scope/Positive.hs
janmasrovira 117020215c
Improve filepath equality (#170)
* improve filepath equality

* replace makeAbsolute by canonicalizePath
2022-06-15 12:38:24 +02:00

161 lines
4.5 KiB
Haskell

module Scope.Positive where
import Base
import Data.HashMap.Strict qualified as HashMap
import MiniJuvix.Internal.NameIdGen
import MiniJuvix.Pipeline
import MiniJuvix.Prelude.Pretty
import MiniJuvix.Syntax.Concrete.Parser qualified as Parser
import MiniJuvix.Syntax.Concrete.Scoped.Pretty qualified as M
import MiniJuvix.Syntax.Concrete.Scoped.Scoper qualified as Scoper
import MiniJuvix.Syntax.Concrete.Scoped.Utils
data PosTest = PosTest
{ _name :: String,
_relDir :: FilePath,
_file :: FilePath
}
makeLenses ''PosTest
root :: FilePath
root = "tests/positive"
renderCode :: M.PrettyCode c => c -> Text
renderCode = prettyText . M.ppOutDefault
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 entryPoint = EntryPoint cwd False (pure entryFile)
step "Parsing"
p :: Parser.ParserResult <- runIO (upToParsing entryPoint)
let p2 = head (p ^. Parser.resultModules)
step "Scoping"
s :: Scoper.ScoperResult <- runIO (pipelineScoper p)
let s2 = head (s ^. Scoper.resultModules)
fs :: HashMap FilePath Text
fs =
HashMap.fromList
[ (getModuleFileAbsPath cwd m, renderCode m)
| m <- toList (getAllModules s2)
]
let scopedPretty = renderCode s2
parsedPretty = renderCode p2
step "Parsing pretty scoped"
let fs2 = HashMap.singleton entryFile scopedPretty
p' :: Parser.ParserResult <-
(runM . runErrorIO @MiniJuvixError . runNameIdGen . runFilesPure fs2)
(upToParsing entryPoint)
step "Parsing pretty parsed"
let fs3 = HashMap.singleton entryFile parsedPretty
parsedPretty' :: Parser.ParserResult <-
(runM . runErrorIO @MiniJuvixError . runNameIdGen . runFilesPure fs3)
(upToParsing entryPoint)
step "Scoping the scoped"
s' :: Scoper.ScoperResult <-
(runM . runErrorIO @MiniJuvixError . runNameIdGen . runFilesPure fs)
(upToScoping entryPoint)
step "Checks"
let smodules = s ^. Scoper.resultModules
smodules' = s' ^. Scoper.resultModules
let pmodules = p ^. Parser.resultModules
pmodules' = p' ^. Parser.resultModules
parsedPrettyModules = parsedPretty' ^. Parser.resultModules
assertEqDiff "check: scope . parse . pretty . scope . parse = scope . parse" smodules smodules'
assertEqDiff "check: parse . pretty . scope . parse = parse" pmodules pmodules'
assertEqDiff "check: parse . pretty . parse = parse" pmodules parsedPrettyModules
}
allTests :: TestTree
allTests =
testGroup
"Scope positive tests"
(map (mkTest . testDescr) tests)
tests :: [PosTest]
tests =
[ PosTest
"Inductive"
"."
"Inductive.mjuvix",
PosTest
"Imports and qualified names"
"Imports"
"A.mjuvix",
PosTest
"Data.Bool from the stdlib"
"StdlibList"
"Data/Bool.mjuvix",
PosTest
"Data.Nat from the stdlib"
"StdlibList"
"Data/Nat.mjuvix",
PosTest
"Data.Ord from the stdlib"
"StdlibList"
"Data/Ord.mjuvix",
PosTest
"Data.Product from the stdlib"
"StdlibList"
"Data/Product.mjuvix",
PosTest
"Data.List and friends from the stdlib"
"StdlibList"
"Data/List.mjuvix",
PosTest
"Operators (+)"
"."
"Operators.mjuvix",
PosTest
"Literals"
"."
"Literals.mjuvix",
PosTest
"Hello World backends"
"."
"HelloWorld.mjuvix",
PosTest
"Axiom with backends"
"."
"Axiom.mjuvix",
PosTest
"Foreign block parsing"
"."
"Foreign.mjuvix",
PosTest
"Multiple modules non-ambiguous symbol - same file"
"QualifiedSymbol"
"M.mjuvix",
PosTest
"Multiple modules non-ambiguous symbol"
"QualifiedSymbol2"
"N.mjuvix",
PosTest
"Multiple modules constructor non-ambiguous symbol"
"QualifiedConstructor"
"M.mjuvix",
PosTest
"open overrides open public"
"."
"ShadowPublicOpen.mjuvix"
]