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
131
132
133
134
135
136
137
|
-- |
-- 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.HUnit
import Test.Tasty.Hedgehog
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 ann)
randomMod' = Hog.resize 20 (randomMod 3 10)
parserInputMod :: Property
parserInputMod = Hog.property $ do
v <- GenVerilog <$> Hog.forAll randomMod' :: Hog.PropertyT IO (GenVerilog (ModDecl ()))
Hog.assert . isRight $
parse
parseModDecl
"input_test_mod"
(alexScanTokens . uncomment "test" $ show v)
parserIdempotentMod :: Property
parserIdempotentMod = Hog.property $ do
v <- Hog.forAll randomMod' :: Hog.PropertyT IO (ModDecl ())
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 :: Gen (Verilog ())))
Hog.assert . isRight $
parse
parseModDecl
"input_test"
(alexScanTokens . uncomment "test" $ show v)
parserIdempotent :: Property
parserIdempotent = Hog.property $ do
v <- Hog.forAll (procedural "top" smallConfig) :: Hog.PropertyT IO (Verilog ())
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 :: String -> String -> ModItem () -> TestTree
test = testParse parseModItem
parseUnitTests :: TestTree
parseUnitTests = testGroup "Parser unit" [parseEventUnit, parseAlwaysUnit]
|
