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 2c8f7c8620fca23d31ba3e5d0888ca2abc9aa656..b2d3c6a110a65befa372f4a45104a518b1cf2b95 100644 (file)
--- 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 b0be736950df6b4dfde6be30d43b1ab7e69a261b..77a8d72de8147c32af55e1702ee4e1e6adcd299a 100644 (file)
--- 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