diff options
Diffstat (limited to 'test/Parser.hs')
-rw-r--r-- | test/Parser.hs | 38 |
1 files changed, 37 insertions, 1 deletions
diff --git a/test/Parser.hs b/test/Parser.hs index 89ab1cc..3c0b77d 100644 --- a/test/Parser.hs +++ b/test/Parser.hs @@ -12,6 +12,7 @@ Test the parser. module Parser ( parserTests + , parseUnitTests ) where @@ -21,6 +22,7 @@ import qualified Hedgehog as Hog import qualified Hedgehog.Gen as Hog import Test.Tasty import Test.Tasty.Hedgehog +import Test.Tasty.HUnit import Text.Parsec import VeriFuzz import VeriFuzz.Verilog.Lex @@ -50,7 +52,41 @@ parserIdempotent = Hog.property $ do $ alexScanTokens sv parserTests :: TestTree -parserTests = testGroup "Parser tests" +parserTests = testGroup "Parser properties" [ testProperty "Input" parserInput , testProperty "Idempotence" parserIdempotent ] + +testParse :: (Eq a, Show a) => Parser a -> String -> String -> a -> TestTree +testParse p name input golden = testCase name $ + case parse p "testcase" (alexScanTokens $ input) of + Left e -> assertFailure $ show e + Right result -> golden @=? result + +testParseFail :: (Eq a, Show a) => Parser a -> String -> String -> TestTree +testParseFail p name input = testCase name $ + case parse p "testcase" (alexScanTokens $ input) of + Left _ -> return () + Right _ -> assertFailure "Parse incorrectly succeeded" + +parseEventUnit :: TestTree +parseEventUnit = + testGroup "Event" + [ testFailure "No empty event" "@()" + , test "@*" EAll + , test "@(*)" EAll + , test "@(posedge clk)" $ EPosEdge "clk" + , test "@(negedge clk)" $ ENegEdge "clk" + , test "@(wire1)" $ EId "wire1" + , test "@(a or b or c or d)" $ EOr (EId "a") (EOr (EId "b") (EOr (EId "c") (EId "d"))) + , test "@(a, b, c, d)" $ EComb (EId "a") (EComb (EId "b") (EComb (EId "c") (EId "d"))) + ] + where + test a = testParse parseEvent ("Test " <> a) a + testFailure = testParseFail parseEvent + +parseUnitTests :: TestTree +parseUnitTests = + testGroup "Parser unit" + [ parseEventUnit + ] |