on master help sign in
Add test to utility test functions
19e2e50Lennart Kolmodin
BitsQC.hs+8−12
@@ -17,8 +17,8 @@ import BitsPut
17import Test.QuickCheck
17import Test.QuickCheck
18
18
19main = do
19main = do
20− quickCheck prop_Bools
20+ quickCheck prop_bitreq
21− quickCheck prop_SimpleCase
21+ quickCheck prop_composite_case
22
22
23 quickCheck (prop_putget_with_bitreq :: Word8 -> Property)
23 quickCheck (prop_putget_with_bitreq :: Word8 -> Property)
24 quickCheck (prop_putget_with_bitreq :: Word16 -> Property)
24 quickCheck (prop_putget_with_bitreq :: Word16 -> Property)
@@ -71,15 +71,13 @@ bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
71bittable :: Bits a => [(Integer, a)]
71bittable :: Bits a => [(Integer, a)]
72bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..64] ]
72bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..64] ]
73
73
74−prop_Bools :: [Bool] -> Property
74+prop_bitreq :: Word64 -> Property
75−prop_Bools bs = property $
75+prop_bitreq w = property $
76− let p = sequence . replicate (length bs) $ getBool
76+ ( w == 0 && bitreq w == 1 )
77− Right bs' = runGet (runBitGet p) lbs
77+ || bitreq w == (bitreq (w `shiftR` 1)) + 1
78− in bs == bs'
79− where lbs = runPut $ runBitPut (mapM_ putBool bs)
80
78
81−prop_SimpleCase :: Bool -> Word16 -> Property
79+prop_composite_case :: Bool -> Word16 -> Property
82−prop_SimpleCase b w = w < 0x8000 ==>
80+prop_composite_case b w = w < 0x8000 ==>
83 let p = do putBool b
81 let p = do putBool b
84 putWord16be 15 w
82 putWord16be 15 w
85 g = do v <- getBool
83 g = do v <- getBool
@@ -92,8 +90,6 @@ prop_SimpleCase b w = w < 0x8000 ==>
92 lbs = runPut (runBitPut p)
90 lbs = runPut (runBitPut p)
93 w' = runGet (runBitGetSimple g) lbs
91 w' = runGet (runBitGetSimple g) lbs
94 in w == w'
92 in w == w'
95− where
96−
97
93
98{-
94{-
99prop_Word32_from_Word8_and_Word16 :: Word8 -> Word16 -> Property
95prop_Word32_from_Word8_and_Word16 :: Word8 -> Word16 -> Property