Commits

Sergey Astanin  committed 2126438

QuickCheck tests.

  • Participants
  • Parent commits 4f1cd0c

Comments (0)

Files changed (3)

File Codec/Binary/Gray.hs

     , showBinary
     ) where
 
-import Data.Bits (Bits, testBit, shiftR, clearBit, bitSize, isSigned)
+import Data.Bits (Bits, testBit, shiftR, bitSize)
     
 xor :: Bool -> Bool -> Bool
 xor p q = (p && not q) || (not p && q)

File Codec/Binary/Gray_props.hs

+-- | QuickCheck properties of Codec.Binary.Gray module.
+module Codec.Binary.Gray_props where
+
+import Test.QuickCheck
+import Codec.Binary.Gray
+
+import Data.Bits (testBit, bitSize, Bits)
+
+prop_num2bin2num_id_Int =
+  label "binaryToBits . bitsToBinary == id [Int]" $
+  forAll (arbitrary :: Gen Int) $ \i ->
+      i == (binaryToBits . bitsToBinary $ i)
+
+prop_num2bin2num_id_Integer =
+  label "binaryToBits . bitsToBinary == id [Integer+]" $
+  let i = (arbitrary :: Gen Integer) `suchThat` (>= 0)
+  in  forAll i (\i -> i == (binaryToBits . bitsToBinary $ i))
+
+prop_correct_bits_Int =
+  label "bitsToBinary is correct [Int]" $
+  forAll (arbitrary :: Gen Int) $ \i ->
+      let bts = map (testBit i) [0..(bitSize i)-1]
+          padded = (bitsToBinary i) ++ (repeat False)
+      in  all id $ zipWith (==) bts padded
+
+prop_bin2gray2bin_id =
+  label "grayToBinary . binaryToGray == binaryToGray . grayToBinary == id" $
+  forAll (listOf $ (arbitrary :: Gen Bool)) $ \bs ->
+      bs == (grayToBinary . binaryToGray $ bs) &&
+      bs == (binaryToGray . grayToBinary $ bs)
+
+prop_gray_succ_Integer =
+  label "Two successive numbers differ in only one bit [Integer+]" $
+  let i = (arbitrary :: Gen Integer) `suchThat` (>= 0)
+  in  forAll i succ_test
+
+prop_gray_succ_Int =
+  label "Two successive numbers differ in only one bit [Int]" $
+  let i = (arbitrary :: Gen Int)
+  in  forAll i succ_test
+
+succ_test :: (Bits a) => a -> Bool
+succ_test = \i ->
+      let n2g = binaryToGray . bitsToBinary
+          g1 = n2g i
+          g2 = n2g (i+1)
+      in  hamming g1 g2 == 1
+
+hamming :: [Bool] -> [Bool] -> Int
+hamming xs ys = go 0 xs ys
+  where
+    go d [] [] = d
+    go d [] ys = go d [False] ys  -- extension for different lengths
+    go d xs [] = go d [False] xs
+    go d (x:xs) (y:ys) =
+        if x == y
+           then go d xs ys
+           else go (d+1) xs ys
+
+all_props =
+  prop_num2bin2num_id_Int .&.
+  prop_num2bin2num_id_Integer .&.
+  prop_correct_bits_Int .&.
+  prop_bin2gray2bin_id .&.
+  prop_gray_succ_Int .&.
+  prop_gray_succ_Integer
 #!/usr/bin/env runhaskell
 import Distribution.Simple
-import Distribution.Simple.LocalBuildInfo
-import Distribution.PackageDescription
 
 import Test.QuickCheck
 import Codec.Binary.Gray_props
 main = defaultMainWithHooks $
        simpleUserHooks { runTests = tests }
 
-tests _ _ _ _ =  quickCheckResult all_props >>= print
+tests _ _ _ _ = 
+    quickCheckWith (stdArgs {maxSuccess = 1000}) all_props