git.iko.soy/binary-bits
on master help sign in
Reimplement some old tests
6a0ad9dLennart Kolmodin
BitsQC.hs+80−17
compare with master
unifiedsplit
@@ -1,51 +1,114 @@
1module Main where
1module Main where
2
2
3import Data.Binary ( encode )
3import Data.Binary ( encode )
4−import Data.Binary.Get
4+import Data.Binary.Get ( runGet )
5−import Data.Binary.Put
5+import Data.Binary.Put ( runPut )
6
6
7import Data.Bits
7import Data.Bits
8import Data.Word
8import Data.Word
9import System.Random
9import System.Random
10
10
11−import BitsGet as BG
11+import BitsGet
12−import qualified BitsPut as BP
12+import BitsPut
13
13
14import Test.QuickCheck
14import Test.QuickCheck
15
15
16main = do
16main = do
17 quickCheck prop_Bools
17 quickCheck prop_Bools
18+ quickCheck prop_SimpleCase
18− quickCheck prop_Word8_putget
19+ quickCheck prop_Word8_putget
20+ quickCheck prop_Word8_putget_list
21+ quickCheck prop_Word16be_putget
22+ quickCheck prop_Word16be_putget_list_simple
23+ quickCheck prop_Word16be_putget_list
19
24
20 -- these tests use the R structure
25 -- these tests use the R structure
21 --
26 --
22 -- quickCheck prop_Word16be_with_offset
27 -- quickCheck prop_Word16be_with_offset
23 -- quickCheck prop_Word16be_list
28 -- quickCheck prop_Word16be_list
24− -- quickCheck prop_SimpleCase
25 -- quickCheck prop_Word32_from_2_Word16
29 -- quickCheck prop_Word32_from_2_Word16
26 -- quickCheck prop_Word32_from_Word8_and_Word16
30 -- quickCheck prop_Word32_from_Word8_and_Word16
27
31
28−prop_Word8_putget :: [Word8] -> Property
32+prop_Word8_putget :: Word8 -> Property
29−prop_Word8_putget ws = length ws <= fromIntegral (maxBound :: Word8) ==>
33+prop_Word8_putget w = property $
30 -- write all word8s with as many bits as it's required
34 -- write all word8s with as many bits as it's required
35+ let p = putWord8 (bitreq w) w
36+ g = getWord8 (bitreq w)
37+ lbs = runPut (runBitPut p)
38+ w' = runGet (runBitGetSimple g) lbs
39+ in w == w'
40+
41+prop_Word16be_putget :: Word16 -> Property
42+prop_Word16be_putget w = property $
43+ -- write all word8s with as many bits as it's required
44+ let p = putWord16be (bitreq w) w
45+ g = getWord16be (bitreq w)
46+ lbs = runPut (runBitPut p)
47+ w' = runGet (runBitGetSimple g) lbs
48+ in w == w'
49+
50+prop_Word8_putget_list :: [Word8] -> Property
51+prop_Word8_putget_list ws = property $
52+ -- write all word8s with as many bits as it's required
31− let p = mapM_ (\v -> BP.putWord8 (bitreq v) v) ws
53+ let p = mapM_ (\v -> putWord8 (bitreq v) v) ws
32− g = mapM BG.getWord8 bitlist
54+ g = mapM getWord8 bitlist
33− lbs = runPut (BP.runBitPut p)
55+ lbs = runPut (runBitPut p)
34 Right ws' = runGet (runBitGet g) lbs
56 Right ws' = runGet (runBitGet g) lbs
35 in ws == ws'
57 in ws == ws'
36 where
58 where
37 bitlist = map bitreq ws
59 bitlist = map bitreq ws
38
60
61+prop_Word16be_putget_list_simple :: [Word16] -> Property
62+prop_Word16be_putget_list_simple ws = property $
63+ -- write all word8s with as many bits as it's required
64+ let p = mapM_ (\v -> putWord16be 16 v) ws
65+ g = mapM (const (getWord16be 16)) ws
66+ lbs = runPut (runBitPut p)
67+ ws' = runGet (runBitGetSimple g) lbs
68+ in ws == ws'
69+ where
70+ bitlist = map bitreq ws
71+
72+prop_Word16be_putget_list :: [Word16] -> Property
73+prop_Word16be_putget_list ws = property $
74+ -- write all word8s with as many bits as it's required
75+ let p = mapM_ (\v -> putWord16be (bitreq v) v) ws
76+ g = mapM getWord16be bitlist
77+ lbs = runPut (runBitPut p)
78+ ws' = runGet (runBitGetSimple g) lbs
79+ in ws == ws'
80+ where
81+ bitlist = map bitreq ws
82+
39− -- number of bits required to write 'v'
83+-- number of bits required to write 'v'
84+bitreq :: (Num b, Bits a, Ord a) => a -> b
40bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
85bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
86+
87+bittable :: Bits a => [(Integer, a)]
41−bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..8] ]
88+bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..16] ]
42
89
43prop_Bools :: [Bool] -> Property
90prop_Bools :: [Bool] -> Property
44prop_Bools bs = property $
91prop_Bools bs = property $
45− let p = sequence . replicate (length bs) $ BG.getBool
92+ let p = sequence . replicate (length bs) $ getBool
46− Right bs' = runGet (BG.runBitGet p) lbs
93+ Right bs' = runGet (runBitGet p) lbs
47 in bs == bs'
94 in bs == bs'
48− where lbs = runPut $ BP.runBitPut (mapM_ BP.putBool bs)
95+ where lbs = runPut $ runBitPut (mapM_ putBool bs)
96+
97+prop_SimpleCase :: Bool -> Word16 -> Property
98+prop_SimpleCase b w = w < 0x8000 ==>
99+ let p = do putBool b
100+ putWord16be 15 w
101+ g = do v <- getBool
102+ case v of
103+ True -> getWord16be 15
104+ False -> do
105+ msb <- getWord8 7
106+ lsb <- getWord8 8
107+ return ((fromIntegral msb `shiftL` 8) .|. fromIntegral lsb)
108+ lbs = runPut (runBitPut p)
109+ w' = runGet (runBitGetSimple g) lbs
110+ in w == w'
111+ where
49
112
50
113
51{-
114{-
@@ -103,7 +166,7 @@ instance Arbitrary Word8 where
103instance Arbitrary Word16 where
166instance Arbitrary Word16 where
104 arbitrary = choose (minBound, maxBound)
167 arbitrary = choose (minBound, maxBound)
105 shrink 0 = []
168 shrink 0 = []
106− shrink n = [ n - 1000, n - 100, n - 10, n - 1 ]
169+ shrink n = [ n - 10000, n - 1000, n - 100, n - 1 ]
107
170
108instance Arbitrary Word32 where
171instance Arbitrary Word32 where
109 arbitrary = choose (minBound, maxBound)
172 arbitrary = choose (minBound, maxBound)