Fixed parser to parse all the generated verilog

1 files changed, 45 insertions, 9 deletions

diff --git a/test/Parser.hs b/test/Parser.hs
index 3c0b77d..d473e05 100644
--- a/test/Parser.hs
+++ b/test/Parser.hs
@@ -16,6 +16,7 @@ module Parser
     )
 where
 
+import           Control.Lens
 import           Data.Either             (either, isRight)
 import           Hedgehog                (Gen, Property, (===))
 import qualified Hedgehog                as Hog
@@ -28,19 +29,22 @@ import           VeriFuzz
 import           VeriFuzz.Verilog.Lex
 import           VeriFuzz.Verilog.Parser
 
+smallConfig :: Config
+smallConfig = defaultConfig & configProperty . propSize .~ 5
+
 randomMod' :: Gen ModDecl
 randomMod' = Hog.resize 20 (randomMod 3 10)
 
-parserInput :: Property
-parserInput = Hog.property $ do
+parserInputMod :: Property
+parserInputMod = Hog.property $ do
     v <- Hog.forAll randomMod'
     Hog.assert . isRight $ parse parseModDecl
-                                 "input_test.v"
+                                 "input_test_mod"
                                  (alexScanTokens $ str v)
     where str = show . GenVerilog
 
-parserIdempotent :: Property
-parserIdempotent = Hog.property $ do
+parserIdempotentMod :: Property
+parserIdempotentMod = Hog.property $ do
     v <- Hog.forAll randomMod'
     let sv = vshow v
     p sv === (p . p) sv
@@ -48,24 +52,44 @@ parserIdempotent = Hog.property $ do
     vshow = show . GenVerilog
     p sv =
         either (\x -> show x <> "\n" <> sv) vshow
-            . parse parseModDecl "idempotent_test.v"
+            . parse parseModDecl "idempotent_test_mod"
             $ alexScanTokens sv
 
+parserInput :: Property
+parserInput = Hog.property $ do
+    v <- Hog.forAll (procedural "top" smallConfig)
+    Hog.assert . isRight $ parse parseModDecl
+                                 "input_test"
+                                 (alexScanTokens $ str v)
+    where str = show . GenVerilog
+
+parserIdempotent :: Property
+parserIdempotent = Hog.property $ do
+    v <- Hog.forAll (procedural "top" smallConfig)
+    let sv = vshow v
+    p sv === (p . p) sv
+  where
+    vshow = show . GenVerilog
+    p sv =
+        either (\x -> show x <> "\n" <> sv) vshow $ parseVerilog "idempotent_test" sv
+
 parserTests :: TestTree
 parserTests = testGroup "Parser properties"
-    [ testProperty "Input" parserInput
+    [ testProperty "Input Mod" parserInputMod
+    , testProperty "Input" parserInput
+    , testProperty "Idempotence Mod" parserIdempotentMod
     , 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
+    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
+    case parse p "testcase" (alexScanTokens input) of
         Left _  -> return ()
         Right _ -> assertFailure "Parse incorrectly succeeded"
 
@@ -80,13 +104,25 @@ parseEventUnit =
     , 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")))
+    , test "@(posedge a or negedge b or c or d)" $ EOr (EPosEdge "a") (EOr (ENegEdge "b") (EOr (EId "c") (EId "d")))
     ]
     where
         test a = testParse parseEvent ("Test " <> a) a
         testFailure = testParseFail parseEvent
 
+parseAlwaysUnit :: TestTree
+parseAlwaysUnit =
+    testGroup "Always"
+    [ test "Empty" "always begin end" $ Always (SeqBlock [])
+    , test "Empty with event @*" "always @* begin end" $ Always (EventCtrl EAll (Just (SeqBlock [])))
+    , test "Empty with event @(posedge clk)" "always @(posedge clk) begin end" $ Always (EventCtrl (EPosEdge "clk") (Just (SeqBlock [])))
+    ]
+    where
+        test = testParse parseModItem
+
 parseUnitTests :: TestTree
 parseUnitTests =
     testGroup "Parser unit"
     [ parseEventUnit
+    , parseAlwaysUnit
     ]