Add always and initial blocks to parser

2 files changed, 39 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
+    ]
diff --git a/test/Unit.hs b/test/Unit.hs
index 7878eaa..a45f120 100644
--- a/test/Unit.hs
+++ b/test/Unit.hs
@@ -4,6 +4,7 @@ module Unit
 where
 
 import           Control.Lens
+import           Parser           (parseUnitTests)
 import           Test.Tasty
 import           Test.Tasty.HUnit
 import           VeriFuzz
@@ -15,6 +16,7 @@ unitTests = testGroup
           "Successful transformation"
           transformExpectedResult
           (transform trans transformTestData)
+    , parseUnitTests
     ]
 
 transformTestData :: Expr