Add precondition to run tests

anoma · Jul 12, 2024 · 3231452 · 3231452
1 parent 3736ed1
commit 3231452
Show file tree

Hide file tree

Showing 19 changed files with 194 additions and 121 deletions.
diff --git a/test/Base.hs b/test/Base.hs
@@ -10,6 +10,7 @@ module Base
   )
 where
 
+import Control.Exception qualified as E
 import Control.Monad.Extra as Monad
 import Data.Algorithm.Diff
 import Data.Algorithm.DiffOutput
@@ -60,6 +61,11 @@ mkTest TestDescr {..} = case _testAssertion of
   Single assertion -> testCase _testName (withCurrentDir _testRoot assertion)
   Steps steps -> testCaseSteps _testName (withCurrentDir _testRoot . steps)
 
+withPrecondition :: Assertion -> IO TestTree -> IO TestTree
+withPrecondition assertion ifSuccess = do
+  E.catch (assertion >> ifSuccess) $ \case
+    E.SomeException e -> return (testCase "Precondition failed" (assertFailure (show e)))
+
 assertEqDiffText :: String -> Text -> Text -> Assertion
 assertEqDiffText = assertEqDiff unpack
 

diff --git a/test/Casm.hs b/test/Casm.hs
@@ -5,5 +5,11 @@ import Casm.Compilation qualified as Compile
 import Casm.Reg qualified as Reg
 import Casm.Run qualified as Run
 
-allTests :: TestTree
-allTests = testGroup "CASM tests" [Run.allTests, Reg.allTests, Compile.allTests]
+allTests :: IO TestTree
+allTests =
+  testGroup "CASM tests"
+    <$> sequence
+      [ Run.allTests,
+        Reg.allTests,
+        Compile.allTests
+      ]
diff --git a/test/Casm/Compilation.hs b/test/Casm/Compilation.hs
@@ -1,8 +1,14 @@
 module Casm.Compilation where
 
 import Base
-import Casm.Compilation.Negative qualified as N
-import Casm.Compilation.Positive qualified as P
+import Casm.Compilation.Negative qualified as Negative
+import Casm.Compilation.Positive qualified as Positive
 
-allTests :: TestTree
-allTests = testGroup "Juvix to CASM compilation" [P.allTests, P.allTestsNoOptimize, N.allTests]
+allTests :: IO TestTree
+allTests =
+  testGroup "Juvix to CASM compilation"
+    <$> sequence
+      [ Positive.allTests,
+        Positive.allTestsNoOptimize,
+        return Negative.allTests
+      ]
diff --git a/test/Casm/Compilation/Base.hs b/test/Casm/Compilation/Base.hs
@@ -1,4 +1,8 @@
-module Casm.Compilation.Base where
+module Casm.Compilation.Base
+  ( module Casm.Compilation.Base,
+    cairoVmPrecondition,
+  )
+where
 
 import Base
 import Casm.Run.Base

diff --git a/test/Casm/Compilation/Positive.hs b/test/Casm/Compilation/Positive.hs
@@ -31,17 +31,22 @@ toTestDescr optLevel PosTest {..} =
           _testAssertion = Steps $ compileAssertion _dir _interp _runVM optLevel file' input' expected'
         }
 
-allTests :: TestTree
-allTests =
-  testGroup
-    "Juvix to CASM positive tests"
-    (map (mkTest . toTestDescr 3) tests)
+mkAllTests :: String -> Int -> IO TestTree
+mkAllTests title optimLevel = do
+  let (vmTests, nonVmTests) = partition (^. runVM) tests
+      vmGroup = testGroup "With VM" (mkTest . toTestDescr optimLevel <$> vmTests)
+  vmTestTree <- withPrecondition cairoVmPrecondition (return vmGroup)
+  let nonVmTestTree = testGroup "Without VM" (mkTest . toTestDescr optimLevel <$> nonVmTests)
+  return $
+    testGroup
+      title
+      [vmTestTree, nonVmTestTree]
 
-allTestsNoOptimize :: TestTree
-allTestsNoOptimize =
-  testGroup
-    "Juvix to CASM positive tests (no optimization)"
-    (map (mkTest . toTestDescr 0) tests)
+allTests :: IO TestTree
+allTests = mkAllTests "CASM run positive tests" 3
+
+allTestsNoOptimize :: IO TestTree
+allTestsNoOptimize = mkAllTests "Juvix to CASM positive tests (no optimization)" 0
 
 posTest :: String -> Bool -> Bool -> Path Rel Dir -> Path Rel File -> Maybe (Path Rel File) -> Path Rel File -> PosTest
 posTest _name _interp _runVM rdir rfile rinfile routfile =

diff --git a/test/Casm/Reg.hs b/test/Casm/Reg.hs
@@ -1,8 +1,14 @@
 module Casm.Reg where
 
 import Base
-import Casm.Reg.Cairo qualified as C
-import Casm.Reg.Positive qualified as P
+import Casm.Reg.Cairo qualified as Cairo
+import Casm.Reg.Positive qualified as Positive
 
-allTests :: TestTree
-allTests = testGroup "JuvixReg to CASM translation" [P.allTests, C.allTests]
+allTests :: IO TestTree
+allTests =
+  testGroup
+    "JuvixReg to CASM translation"
+    <$> sequence
+      [ return Positive.allTests,
+        Cairo.allTests
+      ]
diff --git a/test/Casm/Reg/Base.hs b/test/Casm/Reg/Base.hs
@@ -13,7 +13,7 @@ import Reg.Run.Base qualified as Reg
 compileAssertion' :: EntryPoint -> Maybe (Path Abs File) -> Path Abs Dir -> Path Abs File -> Symbol -> Reg.InfoTable -> (String -> IO ()) -> Assertion
 compileAssertion' entryPoint inputFile _ outputFile _ tab step = do
   step "Translate to CASM"
-  case run $ runError @JuvixError $ runReader entryPoint $ regToCasm tab of
+  case run . runError @JuvixError . runReader entryPoint $ regToCasm tab of
     Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
     Right Result {..} -> do
       step "Interpret"
@@ -30,7 +30,7 @@ compileAssertion' entryPoint inputFile _ outputFile _ tab step = do
 cairoAssertion' :: EntryPoint -> Maybe (Path Abs File) -> Path Abs Dir -> Path Abs File -> Symbol -> Reg.InfoTable -> (String -> IO ()) -> Assertion
 cairoAssertion' entryPoint inputFile dirPath outputFile _ tab step = do
   step "Translate to Cairo"
-  case run $ runError @JuvixError $ runReader entryPoint $ regToCairo tab of
+  case run . runError @JuvixError . runReader entryPoint $ regToCairo tab of
     Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
     Right res -> do
       step "Serialize to Cairo bytecode"

diff --git a/test/Casm/Reg/Cairo.hs b/test/Casm/Reg/Cairo.hs
@@ -3,6 +3,7 @@ module Casm.Reg.Cairo where
 import Base
 import Casm.Reg.Base
 import Casm.Reg.Positive qualified as P
+import Casm.Run.Base (cairoVmPrecondition)
 
 testDescr :: P.PosTest -> TestDescr
 testDescr P.PosTest {..} =
@@ -16,27 +17,28 @@ testDescr P.PosTest {..} =
           _testAssertion = Steps $ regToCairoAssertion tRoot file' input' expected'
         }
 
-allTests :: TestTree
+allTests :: IO TestTree
 allTests =
-  testGroup
-    "JuvixReg to Cairo translation positive tests"
-    ( map (mkTest . testDescr) $
-        P.filterOutTests
-          [ "Test001: Arithmetic opcodes",
-            "Test013: Fibonacci numbers in linear time",
-            "Test014: Trees",
-            "Test016: Arithmetic",
-            "Test017: Closures as arguments",
-            "Test023: McCarthy's 91 function",
-            "Test024: Higher-order recursive functions",
-            "Test027: Fast exponentiation",
-            "Test030: Mutual recursion",
-            "Test031: Temporary stack with branching",
-            "Test036: Streams without memoization"
-          ]
-          P.tests
-          ++ cairoTests
-    )
+  withPrecondition cairoVmPrecondition
+    . return
+    . testGroup
+      "JuvixReg to Cairo translation positive tests"
+    $ map (mkTest . testDescr)
+    $ P.filterOutTests
+      [ "Test001: Arithmetic opcodes",
+        "Test013: Fibonacci numbers in linear time",
+        "Test014: Trees",
+        "Test016: Arithmetic",
+        "Test017: Closures as arguments",
+        "Test023: McCarthy's 91 function",
+        "Test024: Higher-order recursive functions",
+        "Test027: Fast exponentiation",
+        "Test030: Mutual recursion",
+        "Test031: Temporary stack with branching",
+        "Test036: Streams without memoization"
+      ]
+      P.tests
+      ++ cairoTests
 
 cairoTests :: [P.PosTest]
 cairoTests =

diff --git a/test/Casm/Run.hs b/test/Casm/Run.hs
@@ -1,8 +1,8 @@
 module Casm.Run where
 
 import Base
-import Casm.Run.Negative qualified as RunN
-import Casm.Run.Positive qualified as RunP
+import Casm.Run.Negative qualified as Negative
+import Casm.Run.Positive qualified as Positive
 
-allTests :: TestTree
-allTests = testGroup "CASM run" [RunP.allTests, RunN.allTests]
+allTests :: IO TestTree
+allTests = testGroup "CASM run" <$> sequence [Positive.allTests, return Negative.allTests]
diff --git a/test/Casm/Run/Base.hs b/test/Casm/Run/Base.hs
@@ -18,24 +18,25 @@ casmRunVM' dirPath outputFile inputFile = do
   let args = maybe [] (\f -> ["--program_input", toFilePath f]) inputFile
   readProcessCwd (toFilePath dirPath) "run_cairo_vm.sh" (toFilePath outputFile : args) ""
 
+cairoVmPrecondition :: Assertion
+cairoVmPrecondition = do
+  assertCmdExists $(mkRelFile "run_cairo_vm.sh")
+
 casmRunVM :: EntryPoint -> LabelInfo -> Code -> [Builtin] -> Int -> Maybe (Path Abs File) -> Path Abs File -> (String -> IO ()) -> Assertion
 casmRunVM entryPoint labi instrs blts outputSize inputFile expectedFile step = do
-  step "Check run_cairo_vm.sh is on path"
-  assertCmdExists $(mkRelFile "run_cairo_vm.sh")
   withTempDir'
     ( \dirPath -> do
         step "Serialize to Cairo bytecode"
         let res =
-              run $
-                runReader entryPoint $
-                  casmToCairo
-                    ( Casm.Result
-                        { _resultLabelInfo = labi,
-                          _resultCode = instrs,
-                          _resultBuiltins = blts,
-                          _resultOutputSize = outputSize
-                        }
-                    )
+              run
+                . runReader entryPoint
+                $ casmToCairo
+                  Casm.Result
+                    { _resultLabelInfo = labi,
+                      _resultCode = instrs,
+                      _resultBuiltins = blts,
+                      _resultOutputSize = outputSize
+                    }
             outputFile = dirPath <//> $(mkRelFile "out.json")
         encodeFile (toFilePath outputFile) res
         step "Run Cairo VM"
@@ -66,7 +67,18 @@ casmInterpret labi instrs inputFile expectedFile step =
             assertEqDiffText ("Check: RUN output = " <> toFilePath expectedFile) actualOutput expected
     )
 
-casmRunAssertion' :: EntryPoint -> Bool -> Bool -> LabelInfo -> Code -> [Builtin] -> Int -> Maybe (Path Abs File) -> Path Abs File -> (String -> IO ()) -> Assertion
+casmRunAssertion' ::
+  EntryPoint ->
+  Bool ->
+  Bool ->
+  LabelInfo ->
+  Code ->
+  [Builtin] ->
+  Int ->
+  Maybe (Path Abs File) ->
+  Path Abs File ->
+  (String -> IO ()) ->
+  Assertion
 casmRunAssertion' entryPoint bInterp bRunVM labi instrs blts outputSize inputFile expectedFile step =
   case validate labi instrs of
     Left err -> do

diff --git a/test/Casm/Run/Positive.hs b/test/Casm/Run/Positive.hs
@@ -13,6 +13,8 @@ data PosTest = PosTest
     _inputFile :: Maybe (Path Rel File)
   }
 
+makeLenses ''PosTest
+
 root :: Path Abs Dir
 root = relToProject $(mkRelDir "tests/Casm/positive")
 
@@ -28,14 +30,16 @@ testDescr PosTest {..} =
           _testAssertion = Steps $ casmRunAssertion _interp _runVM tRoot file' input' expected'
         }
 
-filterTests :: [String] -> [PosTest] -> [PosTest]
-filterTests incl = filter (\PosTest {..} -> _name `elem` incl)
-
-allTests :: TestTree
-allTests =
-  testGroup
-    "CASM run positive tests"
-    (map (mkTest . testDescr) tests)
+allTests :: IO TestTree
+allTests = do
+  let (vmTests, nonVmTests) = partition (^. runVM) tests
+      vmGroup = testGroup "With VM" (mkTest . testDescr <$> vmTests)
+  vmTestTree <- withPrecondition cairoVmPrecondition (return vmGroup)
+  let nonVmTestTree = testGroup "Without VM" (mkTest . testDescr <$> nonVmTests)
+  return $
+    testGroup
+      "CASM run positive tests"
+      [vmTestTree, nonVmTestTree]
 
 tests :: [PosTest]
 tests =

diff --git a/test/Main.hs b/test/Main.hs
@@ -25,41 +25,45 @@ import Tree qualified
 import Typecheck qualified
 import VampIR qualified
 
-slowTests :: TestTree
+slowTests :: IO TestTree
 slowTests =
   sequentialTestGroup
     "Juvix slow tests"
     AllFinish
-    [ Runtime.allTests,
-      Reg.allTests,
-      Asm.allTests,
-      Tree.allTests,
-      Core.allTests,
-      Internal.allTests,
-      Compilation.allTests,
-      Examples.allTests,
-      Rust.allTests,
-      Casm.allTests,
-      VampIR.allTests,
-      Anoma.allTests,
-      Repl.allTests
-    ]
+    <$> sequence
+      [ return Runtime.allTests,
+        return Reg.allTests,
+        return Asm.allTests,
+        return Tree.allTests,
+        return Core.allTests,
+        return Internal.allTests,
+        return Compilation.allTests,
+        return Examples.allTests,
+        Rust.allTests,
+        Casm.allTests,
+        VampIR.allTests,
+        return Anoma.allTests,
+        return Repl.allTests
+      ]
 
-fastTests :: TestTree
+fastTests :: IO TestTree
 fastTests =
-  testGroup
-    "Juvix fast tests"
-    [ Parsing.allTests,
-      Resolver.allTests,
-      Scope.allTests,
-      Termination.allTests,
-      Typecheck.allTests,
-      Format.allTests,
-      Formatter.allTests,
-      Package.allTests,
-      BackendMarkdown.allTests,
-      Nockma.allTests
-    ]
+  return $
+    testGroup
+      "Juvix fast tests"
+      [ Parsing.allTests,
+        Resolver.allTests,
+        Scope.allTests,
+        Termination.allTests,
+        Typecheck.allTests,
+        Format.allTests,
+        Formatter.allTests,
+        Package.allTests,
+        BackendMarkdown.allTests,
+        Nockma.allTests
+      ]
 
 main :: IO ()
-main = defaultMain (testGroup "Juvix tests" [fastTests, slowTests])
+main = do
+  tests <- sequence [fastTests, slowTests]
+  defaultMain (testGroup "Juvix tests" tests)
diff --git a/test/Rust.hs b/test/Rust.hs
@@ -4,5 +4,7 @@ import Base
 import Rust.Compilation qualified as Compilation
 import Rust.RiscZero qualified as RiscZero
 
-allTests :: TestTree
-allTests = sequentialTestGroup "Juvix to Rust tests" AllFinish [Compilation.allTests, RiscZero.allTests]
+allTests :: IO TestTree
+allTests =
+  sequentialTestGroup "Juvix to Rust tests" AllFinish
+    <$> sequence [Compilation.allTests, RiscZero.allTests]
diff --git a/test/Rust/Compilation.hs b/test/Rust/Compilation.hs
@@ -1,7 +1,10 @@
 module Rust.Compilation where
 
 import Base
+import Rust.Compilation.Base
 import Rust.Compilation.Positive qualified as P
 
-allTests :: TestTree
-allTests = testGroup "Juvix to native Rust compilation tests" [P.allTests, P.allTestsNoOptimize]
+allTests :: IO TestTree
+allTests =
+  withPrecondition precondition . return $
+    testGroup "Juvix to native Rust compilation tests" [P.allTests, P.allTestsNoOptimize]