From f9159b9e1dfaf9a0b449b632913c8efa1b6674ad Mon Sep 17 00:00:00 2001
From: Yann Herklotz Grave <git@yannherklotzgrave.com>
Date: Sat, 16 Feb 2019 21:35:51 +0000
Subject: [Fix #7] Add property test to parser

---
 test/Property.hs | 33 ++++++++++++++++++++++++++++++++-
 1 file changed, 32 insertions(+), 1 deletion(-)

(limited to 'test')

diff --git a/test/Property.hs b/test/Property.hs
index 3edf5d4..8aa2ec3 100644
--- a/test/Property.hs
+++ b/test/Property.hs
@@ -3,10 +3,12 @@ module Property
   )
 where
 
+import           Data.Either                       (isRight)
 import qualified Data.Graph.Inductive              as G
 import           Data.Graph.Inductive.PatriciaTree (Gr)
 import           Test.Tasty
 import qualified Test.Tasty.QuickCheck             as QC
+import           Text.Parsec
 import           VeriFuzz
 import qualified VeriFuzz.RandomAlt                as V
 
@@ -16,6 +18,14 @@ newtype TestGraph = TestGraph { getGraph :: Gr Gate () }
 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 <$> randomMod 3 10
+
 instance QC.Arbitrary TestGraph where
   arbitrary = TestGraph <$> QC.resize 30 randomDAG
 
@@ -30,5 +40,26 @@ 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' :: (GenVerilog VerilogSrc) -> Bool
+--parserIdempotent' v =
+--  p sv == (p . p) sv
+--  where
+--    sv = show v
+--    p = show . fromRight (VerilogSrc []) . parse parseVerilogSrc "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]
+propertyTests = testGroup "Property Tests" [simpleGraph, simpleAltGraph, parserInput]
-- 
cgit