wasm-ifc/test/Main.hs
Stephan Stanisic 3024cd2ca1 binops
2024-11-06 12:41:23 +01:00

52 lines
1.8 KiB
Haskell

module Main where
import Test.Tasty
import Test.Tasty.HUnit
import MiniWasm.Syntax
import MiniWasm.Validation
import MiniWasm.Execution
import MiniWasm.TestCases.SmallStep
import MiniWasm.TestCases.Programs
testSmallStep :: String -> [Config] -> TestTree
testSmallStep name cfgs =
testCase name $
case cfgs of
[] -> pure ()
cfg : cfgs -> go cfg cfgs
where
go _ [] = pure ()
go cfg (cfg' : cfgs) = do
cfg' @=? step cfg
go cfg' cfgs
{-
testModule :: TestName -> Module -> ExpectedOutput -> TestTree
testModule name m expectedOutput =
testCase name $ do
case validateModule m of
Left e -> assertFailure $ "Validation error: " ++ e
Right () ->
case (executeModule m, expectedOutput) of
(Config{instrs = [Trapping reason]}, ExpectTrap reason') -> reason @?= reason'
(Config{instrs = [Trapping reason]}, ExpectStack _) -> assertFailure $ "Expected program to succeed, but it trapped with " ++ show reason ++ "."
(Config{instrs = []}, ExpectTrap reason) -> assertFailure $ "Expected program to trap with reason " ++ show reason ++ ", but it succeeded."
(Config{instrs = [], stack}, ExpectStack stack') -> stack @?= stack'
-- This case should never happen, unless you modify 'stepUntilFinal' or 'executeModule'
_ -> assertFailure "Program is not in final state"
-}
-- If you want to add a new test case, modify the 'testPrograms' list in the MiniWasm.TestCases.Programs module.
testTree :: TestTree
testTree =
testGroup "MiniWasm tests"
[ testGroup "Small-step evaluation" $ fmap (uncurry testSmallStep) smallStepTests
--, testGroup "Full programs" $ fmap (\(name, (m, expected)) -> testModule name m expected) testPrograms
]
main :: IO ()
main = defaultMain testTree