add parsing tests

test/Tree.hs

@@ -3,7 +3,8 @@ module Tree where
 import Base
 import Tree.Asm qualified as Asm
 import Tree.Eval qualified as Eval
+import Tree.Parse qualified as Parse
 import Tree.Transformation qualified as Transformation
 
 allTests :: TestTree
-allTests = testGroup "JuvixTree tests" [Eval.allTests, Asm.allTests, Transformation.allTests]
+allTests = testGroup "JuvixTree tests" [Parse.allTests, Eval.allTests, Asm.allTests, Transformation.allTests]

test/Tree/Parse.hs

@@ -0,0 +1,7 @@
+module Tree.Parse where
+
+import Base
+import Tree.Parse.Positive qualified as P
+
+allTests :: TestTree
+allTests = testGroup "JuvixTree parsing" [P.allTests]

test/Tree/Parse/Base.hs

@@ -0,0 +1,32 @@
+module Tree.Parse.Base where
+
+import Base
+import Juvix.Compiler.Tree.Data.InfoTable
+import Juvix.Compiler.Tree.Pretty
+import Juvix.Compiler.Tree.Translation.FromSource
+import Juvix.Data.PPOutput
+
+treeParseAssertion :: Path Abs File -> (String -> IO ()) -> Assertion
+treeParseAssertion mainFile step = do
+  step "Parse"
+  r <- parseFile mainFile
+  case r of
+    Left err -> assertFailure (prettyString err)
+    Right tab -> do
+      withTempDir'
+        ( \dirPath -> do
+            let outputFile = dirPath <//> $(mkRelFile "out.out")
+            step "Print"
+            writeFileEnsureLn outputFile (ppPrint tab tab)
+            step "Parse printed"
+            r' <- parseFile outputFile
+            case r' of
+              Left err -> assertFailure (prettyString err)
+              Right tab' -> do
+                assertBool ("Check: print . parse = print . parse . print . parse") (ppPrint tab tab == ppPrint tab' tab')
+        )
+
+parseFile :: Path Abs File -> IO (Either MegaparsecError InfoTable)
+parseFile f = do
+  s <- readFile f
+  return (runParser f s)

test/Tree/Parse/Positive.hs

@@ -0,0 +1,23 @@
+module Tree.Parse.Positive where
+
+import Base
+import Tree.Eval.Positive qualified as Eval
+import Tree.Parse.Base
+
+type PosTest = Eval.PosTest
+
+testDescr :: PosTest -> TestDescr
+testDescr Eval.PosTest {..} =
+  let tRoot = Eval.root <//> _relDir
+      file' = tRoot <//> _file
+   in TestDescr
+        { _testName = _name,
+          _testRoot = tRoot,
+          _testAssertion = Steps $ treeParseAssertion file'
+        }
+
+allTests :: TestTree
+allTests =
+  testGroup
+    "JuvixTree parsing positive tests"
+    (map (mkTest . testDescr) Eval.tests)