From: Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
Date: Sun, 26 Apr 2015 12:07:18 +0000 (+0530)
Subject: add QuickCheck test to the test suite.
X-Git-Url: https://git.rkrishnan.org/listings/vdrive/something?a=commitdiff_plain;h=6154a22cd080112176183d3c122b1492a5623481;p=functorrent.git

add QuickCheck test to the test suite.

Bug: tests do not terminate because of the recursive nature of
the BVal data type.
---

diff --git a/functorrent.cabal b/functorrent.cabal
index 2c8f7c8..b2d3c6a 100644
--- a/functorrent.cabal
+++ b/functorrent.cabal
@@ -73,7 +73,10 @@ test-suite functorrent-test
                      directory,
                      doctest,
                      tasty,
-                     tasty-hunit
+                     tasty-hunit,
+                     QuickCheck,
+                     tasty-quickcheck,
+                     test-framework-quickcheck2
 
 test-suite functorrent-hlint
   type:              exitcode-stdio-1.0
diff --git a/test/Test.hs b/test/Test.hs
index b0be736..77a8d72 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -6,10 +6,11 @@ import Prelude hiding (readFile)
 import Data.ByteString (ByteString, readFile)
 import Data.Map.Strict (fromList)
 
-import Test.Tasty
-import Test.Tasty.HUnit
+import Test.Tasty (TestTree, testGroup, defaultMain)
+import Test.Tasty.HUnit (testCase, (@?=))
+import Test.Tasty.QuickCheck (testProperty)
 
-import FuncTorrent.Bencode (decode, BVal(..))
+import FuncTorrent.Bencode (encode, decode, BVal(..))
 import FuncTorrent.Metainfo (Info(..), Metainfo(..), mkMetaInfo)
 import FuncTorrent.Peer (Peer(..))
 import FuncTorrent.Tracker
@@ -92,8 +93,16 @@ unitTests :: TestTree
 unitTests = testGroup "Unit tests" [testFile, testMkMetaInfo, testResponse1,
                                             testResponse2]
 
+propEncodeDecode :: BVal -> Bool
+propEncodeDecode bval = let encoded = encode bval
+                            decoded = decode encoded
+                        in Right bval == decoded
+
+qcTests :: TestTree
+qcTests = testGroup "QuickCheck tests" [ testProperty "encode/decode" propEncodeDecode ]
+
 tests :: TestTree
-tests = testGroup "Tests" [unitTests]
+tests = testGroup "Tests" [unitTests, qcTests]
 
 main :: IO ()
 main = defaultMain tests