git.iko.soy/binary-bits
on master help sign in
Cleanup in tests
4b75399Lennart Kolmodin
BitsQC.hs+4−34
compare with master
unifiedsplit
@@ -24,14 +24,12 @@ main = do
24
24
25 -- these tests use the R structure
25 -- these tests use the R structure
26 --
26 --
27− -- quickCheck prop_Word16be_with_offset
28− -- quickCheck prop_Word16be_list
29 -- quickCheck prop_Word32_from_2_Word16
27 -- quickCheck prop_Word32_from_2_Word16
30 -- quickCheck prop_Word32_from_Word8_and_Word16
28 -- quickCheck prop_Word32_from_Word8_and_Word16
31
29
32prop_Word8_putget :: Word8 -> Property
30prop_Word8_putget :: Word8 -> Property
33prop_Word8_putget w = property $
31prop_Word8_putget w = property $
34− -- write all word8s with as many bits as it's required
32+ -- write all words with as many bits as it's required
35 let p = putWord8 (bitreq w) w
33 let p = putWord8 (bitreq w) w
36 g = getWord8 (bitreq w)
34 g = getWord8 (bitreq w)
37 lbs = runPut (runBitPut p)
35 lbs = runPut (runBitPut p)
@@ -40,7 +38,7 @@ prop_Word8_putget w = property $
40
38
41prop_Word16be_putget :: Word16 -> Property
39prop_Word16be_putget :: Word16 -> Property
42prop_Word16be_putget w = property $
40prop_Word16be_putget w = property $
43− -- write all word8s with as many bits as it's required
41+ -- write all words with as many bits as it's required
44 let p = putWord16be (bitreq w) w
42 let p = putWord16be (bitreq w) w
45 g = getWord16be (bitreq w)
43 g = getWord16be (bitreq w)
46 lbs = runPut (runBitPut p)
44 lbs = runPut (runBitPut p)
@@ -60,7 +58,6 @@ prop_Word8_putget_list ws = property $
60
58
61prop_Word16be_putget_list_simple :: [Word16] -> Property
59prop_Word16be_putget_list_simple :: [Word16] -> Property
62prop_Word16be_putget_list_simple ws = property $
60prop_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
61 let p = mapM_ (\v -> putWord16be 16 v) ws
65 g = mapM (const (getWord16be 16)) ws
62 g = mapM (const (getWord16be 16)) ws
66 lbs = runPut (runBitPut p)
63 lbs = runPut (runBitPut p)
@@ -71,7 +68,7 @@ prop_Word16be_putget_list_simple ws = property $
71
68
72prop_Word16be_putget_list :: [Word16] -> Property
69prop_Word16be_putget_list :: [Word16] -> Property
73prop_Word16be_putget_list ws = property $
70prop_Word16be_putget_list ws = property $
74− -- write all word8s with as many bits as it's required
71+ -- write all words with as many bits as it's required
75 let p = mapM_ (\v -> putWord16be (bitreq v) v) ws
72 let p = mapM_ (\v -> putWord16be (bitreq v) v) ws
76 g = mapM getWord16be bitlist
73 g = mapM getWord16be bitlist
77 lbs = runPut (runBitPut p)
74 lbs = runPut (runBitPut p)
@@ -85,7 +82,7 @@ bitreq :: (Num b, Bits a, Ord a) => a -> b
85bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
82bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
86
83
87bittable :: Bits a => [(Integer, a)]
84bittable :: Bits a => [(Integer, a)]
88−bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..16] ]
85+bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..64] ]
89
86
90prop_Bools :: [Bool] -> Property
87prop_Bools :: [Bool] -> Property
91prop_Bools bs = property $
88prop_Bools bs = property $
@@ -112,33 +109,6 @@ prop_SimpleCase b w = w < 0x8000 ==>
112
109
113
110
114{-
111{-
115−prop_SimpleCase :: Word16 -> Property
116−prop_SimpleCase w = w < 0x8000 ==>
117− let p = RMap RBool $ \v -> case v of
118− True -> RWord16be 15
119− False -> RMapPure
120− (RWord8 7 `RNextTo` RWord8 8)
121− (\(msb:*:lsb)-> (fromIntegral msb `shiftL` 8) .|. fromIntegral lsb)
122− w' = runGet (get p) lbs
123− in w == w'
124− where
125− lbs = runPut (putWord16be w)
126−
127−prop_Word16be_with_offset :: Word16 -> Property
128−prop_Word16be_with_offset w = w < 0x8000 ==>
129− let b :*: w' :*: w'' = runGet (get (RCheck RBool not "fail" `RNextTo` RWord16be 15 `RNextTo` RWord16be 16)) lbs
130− in w == w' && w == w''
131− where
132− lbs = runPut (putWord16be w >> putWord16be w)
133−
134−prop_Word16be_list :: Word8 -> [Word16] -> Property
135−prop_Word16be_list w ws = property $
136− let p = RWord8 8 `RNextTo` RList (length ws) (RWord16be 16) :: R (T Word8 [Word16])
137− w' :*: ws' = runGet (get p) lbs :: T Word8 [Word16]
138− in ws == ws' && w == w'
139− where
140− lbs = runPut (putWord8 w >> mapM_ putWord16be ws)
141−
142prop_Word32_from_Word8_and_Word16 :: Word8 -> Word16 -> Property
112prop_Word32_from_Word8_and_Word16 :: Word8 -> Word16 -> Property
143prop_Word32_from_Word8_and_Word16 w8 w16 = property $
113prop_Word32_from_Word8_and_Word16 w8 w16 = property $
144 let p = RWord32be 24
114 let p = RWord32be 24