git.iko.soy/binary-bits
on master help sign in
Two more QuickCheck tests
53204a2Lennart Kolmodin
BitsQC.hs+26−1
compare with master
unifiedsplit
@@ -8,7 +8,8 @@ import Data.Bits
8import Data.Word
8import Data.Word
9import System.Random
9import System.Random
10
10
11−import Bits
11+import BitsGet as BG
12+import qualified BitsPut as BP
12
13
13import Test.QuickCheck
14import Test.QuickCheck
14
15
@@ -18,6 +19,8 @@ main = do
18 quickCheck prop_SimpleCase
19 quickCheck prop_SimpleCase
19 quickCheck prop_Word32_from_2_Word16
20 quickCheck prop_Word32_from_2_Word16
20 quickCheck prop_Word32_from_Word8_and_Word16
21 quickCheck prop_Word32_from_Word8_and_Word16
22+ quickCheck prop_Bools
23+ quickCheck prop_Word8_putget
21
24
22prop_SimpleCase :: Word16 -> Property
25prop_SimpleCase :: Word16 -> Property
23prop_SimpleCase w = w < 0x8000 ==>
26prop_SimpleCase w = w < 0x8000 ==>
@@ -31,6 +34,28 @@ prop_SimpleCase w = w < 0x8000 ==>
31 where
34 where
32 lbs = runPut (putWord16be w)
35 lbs = runPut (putWord16be w)
33
36
37+prop_Word8_putget :: [Word8] -> Property
38+prop_Word8_putget ws = length ws <= fromIntegral (maxBound :: Word8) ==>
39+ -- write all word8s with as many bits as it's required
40+ let p = mapM_ (\v -> BP.putWord8be (bitreq v) v) ws
41+ g = mapM BG.getWord8 bitlist
42+ lbs = runPut (BP.runBitPut p)
43+ Right ws' = runGet (runBitGet g) lbs
44+ in ws == ws'
45+ where
46+ bitlist = map bitreq ws
47+
48+ -- number of bits required to write 'v'
49+bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
50+bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..8] ]
51+
52+prop_Bools :: [Bool] -> Property
53+prop_Bools bs = property $
54+ let p = sequence . replicate (length bs) $ BG.getBool
55+ Right bs' = runGet (BG.runBitGet p) lbs
56+ in bs == bs'
57+ where lbs = runPut $ BP.runBitPut (mapM_ BP.putBool bs)
58+
34prop_Word16be_with_offset :: Word16 -> Property
59prop_Word16be_with_offset :: Word16 -> Property
35prop_Word16be_with_offset w = w < 0x8000 ==>
60prop_Word16be_with_offset w = w < 0x8000 ==>
36 let b :*: w' :*: w'' = runGet (get (RCheck RBool not "fail" `RNextTo` RWord16be 15 `RNextTo` RWord16be 16)) lbs
61 let b :*: w' :*: w'' = runGet (get (RCheck RBool not "fail" `RNextTo` RWord16be 15 `RNextTo` RWord16be 16)) lbs