@@ -1,51 +1,114 @@
11module Main where
22
33import Data.Binary ( encode )
4−import Data.Binary.Get
5−import Data.Binary.Put
4+import Data.Binary.Get ( runGet )
5+import Data.Binary.Put ( runPut )
66
77import Data.Bits
88import Data.Word
99import System.Random
1010
11−import BitsGet as BG
12−import qualified BitsPut as BP
11+import BitsGet
12+import BitsPut
1313
1414import Test.QuickCheck
1515
1616main = do
1717 quickCheck prop_Bools
18− quickCheck prop_Word8_putget
18+ quickCheck prop_SimpleCase
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
1924
2025 -- these tests use the R structure
2126 --
2227 -- quickCheck prop_Word16be_with_offset
2328 -- quickCheck prop_Word16be_list
24− -- quickCheck prop_SimpleCase
2529 -- quickCheck prop_Word32_from_2_Word16
2630 -- quickCheck prop_Word32_from_Word8_and_Word16
2731
28−prop_Word8_putget :: [Word8] -> Property
29−prop_Word8_putget ws = length ws <= fromIntegral (maxBound :: Word8) ==>
32+prop_Word8_putget :: Word8 -> Property
33+prop_Word8_putget w = property $
3034 -- write all word8s with as many bits as it's required
31− let p = mapM_ (\v -> BP.putWord8 (bitreq v) v) ws
32− g = mapM BG.getWord8 bitlist
33− lbs = runPut (BP.runBitPut p)
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
53+ let p = mapM_ (\v -> putWord8 (bitreq v) v) ws
54+ g = mapM getWord8 bitlist
55+ lbs = runPut (runBitPut p)
3456 Right ws' = runGet (runBitGet g) lbs
3557 in ws == ws'
3658 where
3759 bitlist = map bitreq ws
3860
39− -- number of bits required to write 'v'
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+
83+-- number of bits required to write 'v'
84+bitreq :: (Num b, Bits a, Ord a) => a -> b
4085bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
41−bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..8] ]
86+
87+bittable :: Bits a => [(Integer, a)]
88+bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..16] ]
4289
4390prop_Bools :: [Bool] -> Property
4491prop_Bools bs = property $
45− let p = sequence . replicate (length bs) $ BG.getBool
46− Right bs' = runGet (BG.runBitGet p) lbs
92+ let p = sequence . replicate (length bs) $ getBool
93+ Right bs' = runGet (runBitGet p) lbs
4794 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
49112
50113
51114{-
@@ -103,7 +166,7 @@ instance Arbitrary Word8 where
103166instance Arbitrary Word16 where
104167 arbitrary = choose (minBound, maxBound)
105168 shrink 0 = []
106− shrink n = [ n - 1000, n - 100, n - 10, n - 1 ]
169+ shrink n = [ n - 10000, n - 1000, n - 100, n - 1 ]
107170
108171instance Arbitrary Word32 where
109172 arbitrary = choose (minBound, maxBound)