1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
{-|
Module : Parser
Description : Test the parser.
Copyright : (c) 2019, Yann Herklotz Grave
License : GPL-3
Maintainer : yann [at] yannherklotz [dot] com
Stability : experimental
Portability : POSIX
Test the parser.
-}
module Parser
( parserTests
, parseUnitTests
)
where
import Control.Lens
import Data.Either (either, isRight)
import Hedgehog (Gen, Property, (===))
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.Internal
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)
parserInputMod :: Property
parserInputMod = Hog.property $ do
v <- Hog.forAll randomMod'
Hog.assert . isRight $ parse parseModDecl
"input_test_mod"
(alexScanTokens $ str v)
where str = show . GenVerilog
parserIdempotentMod :: Property
parserIdempotentMod = Hog.property $ do
v <- Hog.forAll randomMod'
let sv = vshow v
p sv === (p . p) sv
where
vshow = show . GenVerilog
p sv =
either (\x -> show x <> "\n" <> sv) vshow
. 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 = showT . GenVerilog
p sv = either (\x -> showT x <> "\n" <> sv) vshow
$ parseVerilog "idempotent_test" sv
parserTests :: TestTree
parserTests = testGroup
"Parser properties"
[ 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
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")))
, 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]
|
