blob: 0d1b1545d50b60309f4882c87a4b7b14a160fe5e (
plain)
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
|
module Property
( propertyTests
)
where
import Data.Either (fromRight, isRight)
import qualified Data.Graph.Inductive as G
import Data.Graph.Inductive.PatriciaTree (Gr)
import Test.Tasty
import Test.Tasty.QuickCheck ((===))
import qualified Test.Tasty.QuickCheck as QC
import Text.Parsec
import VeriFuzz
import qualified VeriFuzz.RandomAlt as V
newtype TestGraph = TestGraph { getGraph :: Gr Gate () }
deriving (Show)
newtype AltTestGraph = AltTestGraph { getAltGraph :: Gr Gate () }
deriving (Show)
newtype ModDeclSub = ModDeclSub { getModDecl :: ModDecl }
instance Show ModDeclSub where
show = show . GenVerilog . getModDecl
instance QC.Arbitrary ModDeclSub where
arbitrary = ModDeclSub <$> QC.resize 20 (randomMod 3 10)
instance QC.Arbitrary TestGraph where
arbitrary = TestGraph <$> QC.resize 30 randomDAG
instance QC.Arbitrary AltTestGraph where
arbitrary = AltTestGraph <$> QC.resize 100 V.randomDAG
simpleGraph :: TestTree
simpleGraph = QC.testProperty "simple graph generation check" $ \graph -> simp graph
where simp = G.isSimple . getGraph
simpleAltGraph :: TestTree
simpleAltGraph = QC.testProperty "simple alternative graph generation check" $ \graph -> simp graph
where simp = G.isSimple . getAltGraph
parserInput' :: ModDeclSub -> Bool
parserInput' (ModDeclSub v) =
isRight $ parse parseModDecl "input_test.v" str
where
str = show . GenVerilog $ v
parserIdempotent' :: ModDeclSub -> QC.Property
parserIdempotent' (ModDeclSub v) =
p sv === (p . p) sv
where
vshow = show . GenVerilog
sv = vshow v
p = vshow . fromRight (error "Failed idempotent test")
. parse parseModDecl "idempotent_test.v"
parserInput :: TestTree
parserInput = QC.testProperty "parser input" $
parserInput'
parserIdempotent :: TestTree
parserIdempotent = QC.testProperty "parser idempotence" $
parserIdempotent'
propertyTests :: TestTree
propertyTests = testGroup "Property Tests" [simpleGraph, simpleAltGraph
, parserInput, parserIdempotent]
|
