transformation tests

test/Reg.hs

@@ -3,6 +3,7 @@ module Reg where
 import Base
 import Reg.Parse qualified as Parse
 import Reg.Run qualified as Run
+import Reg.Transformation qualified as Transformation
 
 allTests :: TestTree
-allTests = testGroup "JuvixReg tests" [Parse.allTests, Run.allTests]
+allTests = testGroup "JuvixReg tests" [Parse.allTests, Run.allTests, Transformation.allTests]

test/Reg/Run/Base.hs

@@ -5,6 +5,7 @@ import Juvix.Compiler.Reg.Data.InfoTable
 import Juvix.Compiler.Reg.Error
 import Juvix.Compiler.Reg.Interpreter
 import Juvix.Compiler.Reg.Pretty
+import Juvix.Compiler.Reg.Transformation
 import Juvix.Compiler.Reg.Translation.FromSource
 import Juvix.Data.PPOutput
 
@@ -41,18 +42,20 @@ regRunAssertionParam' interpretFun tab expectedFile step = do
         )
     Nothing -> assertFailure "no 'main' function"
 
-regRunAssertion :: Path Abs File -> Path Abs File -> (InfoTable -> Either RegError InfoTable) -> (InfoTable -> Assertion) -> (String -> IO ()) -> Assertion
+regRunAssertion :: Path Abs File -> Path Abs File -> [TransformationId] -> (InfoTable -> Assertion) -> (String -> IO ()) -> Assertion
 regRunAssertion = regRunAssertionParam runAssertion
 
-regRunAssertionParam :: (Handle -> Symbol -> InfoTable -> IO ()) -> Path Abs File -> Path Abs File -> (InfoTable -> Either RegError InfoTable) -> (InfoTable -> Assertion) -> (String -> IO ()) -> Assertion
+regRunAssertionParam :: (Handle -> Symbol -> InfoTable -> IO ()) -> Path Abs File -> Path Abs File -> [TransformationId] -> (InfoTable -> Assertion) -> (String -> IO ()) -> Assertion
 regRunAssertionParam interpretFun mainFile expectedFile trans testTrans step = do
   step "Parse"
   r <- parseFile mainFile
   case r of
     Left err -> assertFailure (show (pretty err))
     Right tab0 -> do
-      case trans tab0 of
-        Left err -> assertFailure (show (pretty err))
+      unless (null trans) $
+        step "Transform"
+      case run $ runError @JuvixError $ applyTransformations trans tab0 of
+        Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
         Right tab -> do
           testTrans tab
           regRunAssertionParam' interpretFun tab expectedFile step

test/Reg/Run/Positive.hs

@@ -14,7 +14,7 @@ testDescr Parse.PosTest {..} =
    in TestDescr
         { _testName = _name,
           _testRoot = tRoot,
-          _testAssertion = Steps $ regRunAssertion file' expected' return (const (return ()))
+          _testAssertion = Steps $ regRunAssertion file' expected' [] (const (return ()))
         }
 
 allTests :: TestTree

test/Reg/Transformation.hs

@@ -0,0 +1,11 @@
+module Reg.Transformation where
+
+import Base
+import Reg.Transformation.Identity qualified as Identity
+
+allTests :: TestTree
+allTests =
+  testGroup
+    "JuvixReg transformations"
+    [ Identity.allTests
+    ]

test/Reg/Transformation/Base.hs

@@ -0,0 +1,31 @@
+module Reg.Transformation.Base where
+
+import Base
+import Juvix.Compiler.Reg.Data.InfoTable
+import Juvix.Compiler.Reg.Transformation
+import Reg.Parse.Positive qualified as Parse
+import Reg.Run.Base
+
+data Test = Test
+  { _testTransformations :: [TransformationId],
+    _testAssertion :: InfoTable -> Assertion,
+    _testRun :: Parse.PosTest
+  }
+
+fromTest :: Test -> TestTree
+fromTest = mkTest . toTestDescr
+
+root :: Path Abs Dir
+root = relToProject $(mkRelDir "tests/Reg/positive/")
+
+toTestDescr :: Test -> TestDescr
+toTestDescr Test {..} =
+  let Parse.PosTest {..} = _testRun
+      tRoot = root <//> _relDir
+      file' = tRoot <//> _file
+      expected' = tRoot <//> _expectedFile
+   in TestDescr
+        { _testName = _name,
+          _testRoot = tRoot,
+          _testAssertion = Steps $ regRunAssertion file' expected' _testTransformations _testAssertion
+        }

test/Reg/Transformation/Identity.hs

@@ -0,0 +1,21 @@
+module Reg.Transformation.Identity where
+
+import Base
+import Juvix.Compiler.Reg.Transformation
+import Reg.Parse.Positive qualified as Parse
+import Reg.Transformation.Base
+
+allTests :: TestTree
+allTests = testGroup "Identity" (map liftTest Parse.tests)
+
+pipe :: [TransformationId]
+pipe = [Identity]
+
+liftTest :: Parse.PosTest -> TestTree
+liftTest _testRun =
+  fromTest
+    Test
+      { _testTransformations = pipe,
+        _testAssertion = const (return ()),
+        _testRun
+      }