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
|
{-|
Module : Parser
Description : Test the parser.
Copyright : (c) 2019, Yann Herklotz Grave
License : GPLv3
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 Verismith
import Verismith.Internal
import Verismith.Verilog.Lex
import Verismith.Verilog.Parser
import Verismith.Verilog.Preprocess (uncomment)
smallConfig :: Config
smallConfig = defaultConfig & configProperty . propSize .~ 5
randomMod' :: Gen ModDecl
randomMod' = Hog.resize 20 (randomMod 3 10)
parserInputMod :: Property
parserInputMod = Hog.property $ do
v <- GenVerilog <$> Hog.forAll randomMod'
Hog.assert . isRight $ parse parseModDecl
"input_test_mod"
(alexScanTokens . uncomment "test" $ show v)
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 (GenVerilog <$> procedural "top" smallConfig)
Hog.assert . isRight $ parse parseModDecl
"input_test"
(alexScanTokens . uncomment "test" $ show v)
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]
|
