2d75d41 · binary-bits · git.iko.soy

git.iko.soy/binary-bits

on master help sign in

Add more tests

2d75d41Lennart Kolmodin16 years ago

BitsQC.hs+94−1

compare with master

unifiedsplit

@@ -1,9 +1,12 @@

1module Main where

3−import Data.Binary ( encode )

3+import Data.Binary ( encode, Binary(..) )

4import Data.Binary.Get ( runGet )

5import Data.Binary.Put ( runPut )

7+import qualified Data.Binary.Get as BG ( getWord8, getWord16be, getWord32be, getWord64be )

8+import qualified Data.Binary.Put as BP ( putWord8, putWord16be, putWord32be, putWord64be )

7import Bits

10import Bits

9import Data.Bits

12import Data.Bits

@@ -44,6 +47,34 @@ tests =

44 , testGroup "Custom test cases"

47 , testGroup "Custom test cases"

45 [ testProperty "prop_composite_case" prop_composite_case ]

48 [ testProperty "prop_composite_case" prop_composite_case ]

50+ , testGroup "prop_bitput_with_get_from_binary"

51+ [ testProperty "Word8" (prop_bitput_with_get_from_binary :: [Word8] -> Property)

52+ , testProperty "Word16" (prop_bitput_with_get_from_binary :: [Word16] -> Property)

53+ , testProperty "Word32" (prop_bitput_with_get_from_binary :: [Word32] -> Property)

54+ -- , testProperty "Word64" (prop_bitput_with_get_from_binary :: [Word64] -> Property)

55+ ]

56+

57+ , testGroup "prop_bitget_with_put_from_binary"

58+ [ testProperty "Word8" (prop_bitget_with_put_from_binary :: [Word8] -> Property)

59+ , testProperty "Word16" (prop_bitget_with_put_from_binary :: [Word16] -> Property)

60+ , testProperty "Word32" (prop_bitget_with_put_from_binary :: [Word32] -> Property)

61+ -- , testProperty "Word64" (prop_bitget_with_put_from_binary :: [Word64] -> Property)

62+ ]

63+

64+ , testGroup "prop_compare_put_with_naive"

65+ [ testProperty "Word8" (prop_compare_put_with_naive :: [Word8] -> Property)

66+ , testProperty "Word16" (prop_compare_put_with_naive :: [Word16] -> Property)

67+ , testProperty "Word32" (prop_compare_put_with_naive :: [Word32] -> Property)

68+ -- , testProperty "Word64" (prop_compare_put_with_naive :: [Word64] -> Property)

69+ ]

70+

71+ , testGroup "prop_compare_get_with_naive"

72+ [ testProperty "Word8" (prop_compare_get_with_naive:: [Word8] -> Property)

73+ , testProperty "Word16" (prop_compare_get_with_naive:: [Word16] -> Property)

74+ , testProperty "Word32" (prop_compare_get_with_naive:: [Word32] -> Property)

75+ -- , testProperty "Word64" (prop_compare_get_with_naive:: [Word64] -> Property)

76+ ]

77+

47 , testGroup "prop_put_with_bitreq"

78 , testGroup "prop_put_with_bitreq"

48 [ testProperty "Word8" (prop_putget_with_bitreq :: Word8 -> Property)

79 [ testProperty "Word8" (prop_putget_with_bitreq :: Word8 -> Property)

49 , testProperty "Word16" (prop_putget_with_bitreq :: Word16 -> Property)

80 , testProperty "Word16" (prop_putget_with_bitreq :: Word16 -> Property)

@@ -83,6 +114,8 @@ prop_putget_with_bitreq w = property $

83 w' = runGet (runBitGetSimple g) lbs

114 w' = runGet (runBitGetSimple g) lbs

84 in w == w'

115 in w == w'

116

117+-- | Write a list of items. Each item is written with the maximum amount of

118+-- bits, i.e. 8 for Word8, 16 for Word16, etc.

86prop_putget_list_simple :: (BinaryBit a, Eq a, Storable a) => [a] -> Property

119prop_putget_list_simple :: (BinaryBit a, Eq a, Storable a) => [a] -> Property

87prop_putget_list_simple ws = property $

120prop_putget_list_simple ws = property $

88 let s = sizeOf (head ws) * 8

121 let s = sizeOf (head ws) * 8

@@ -92,6 +125,8 @@ prop_putget_list_simple ws = property $

92 ws' = runGet (runBitGetSimple g) lbs

125 ws' = runGet (runBitGetSimple g) lbs

93 in ws == ws'

126 in ws == ws'

127

128+-- | Write a list of items. Each item is written with exactly as many bits

129+-- as required. Then read it back.

95prop_putget_list_with_bitreq :: (BinaryBit a, Num a, Bits a, Ord a) => [a] -> Property

130prop_putget_list_with_bitreq :: (BinaryBit a, Num a, Bits a, Ord a) => [a] -> Property

96prop_putget_list_with_bitreq ws = property $

131prop_putget_list_with_bitreq ws = property $

97 -- write all words with as many bits as it's required

132 -- write all words with as many bits as it's required

@@ -103,6 +138,28 @@ prop_putget_list_with_bitreq ws = property $

103 where

138 where

104 bitlist = map bitreq ws

139 bitlist = map bitreq ws

105

140

141+-- | Write bits using this library, and read them back using the binary

142+-- library.

143+prop_bitput_with_get_from_binary :: (BinaryBit a, Binary a, Storable a, Eq a) => [a] -> Property

144+prop_bitput_with_get_from_binary ws = property $

145+ let s = sizeOf (head ws) * 8

146+ p = mapM_ (putBits s) ws

147+ g = mapM (const get) ws

148+ lbs = runPut (runBitPut p)

149+ ws' = runGet g lbs

150+ in ws == ws'

151+

152+-- | Write bits using the binary library, and read them back using this

153+-- library.

154+prop_bitget_with_put_from_binary :: (BinaryBit a, Binary a, Storable a, Eq a) => [a] -> Property

155+prop_bitget_with_put_from_binary ws = property $

156+ let s = sizeOf (head ws) * 8

157+ p = mapM_ put ws

158+ g = mapM (const (getBits s)) ws

159+ lbs = runPut p

160+ ws' = runGet (runBitGetSimple g) lbs

161+ in ws == ws'

162+

106-- number of bits required to write 'v'

163-- number of bits required to write 'v'

107bitreq :: (Num b, Bits a, Ord a) => a -> b

164bitreq :: (Num b, Bits a, Ord a) => a -> b

108bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]

165bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]

@@ -130,6 +187,42 @@ prop_composite_case b w = w < 0x8000 ==>

130 w' = runGet (runBitGetSimple g) lbs

187 w' = runGet (runBitGetSimple g) lbs

131 in w == w'

188 in w == w'

132

189

190+

191+prop_compare_put_with_naive :: (Bits a, BinaryBit a, Ord a) => [a] -> Property

192+prop_compare_put_with_naive ws = property $

193+ let pn = mapM_ (\v -> naive_put (bitreq v) v) ws

194+ p = mapM_ (\v -> putBits (bitreq v) v) ws

195+ lbs_n = runPut (runBitPut pn)

196+ lbs = runPut (runBitPut p)

197+ in lbs_n == lbs

198+

199+prop_compare_get_with_naive :: (Bits a, BinaryBit a, Ord a, Num a) => [a] -> Property

200+prop_compare_get_with_naive ws = property $

201+ let gn = mapM (\v -> naive_get (bitreq v)) ws

202+ g = mapM (\v -> getBits (bitreq v)) ws

203+ p = mapM_ (\v -> naive_put (bitreq v) v) ws

204+ lbs = runPut (runBitPut p)

205+ rn = runGet (runBitGetSimple gn) lbs

206+ r = runGet (runBitGetSimple g ) lbs

207+ -- we must help our compiler to resolve the types of 'gn' and 'g'

208+ types = rn == ws && r == ws

209+ in rn == r

210+

211+-- | Write one bit at a time until the full word has been written

212+naive_put :: (Bits a) => Int -> a -> BitPut ()

213+naive_put n w = mapM_ (\b -> putBool (testBit w b)) [n-1,n-2..0]

214+

215+-- | Read one bit at a time until we've reconstructed the whole word

216+naive_get :: (Bits a, Num a) => Int -> BitGet a

217+naive_get n0 =

218+ let loop 0 acc = return acc

219+ loop n acc = do

220+ b <- getBool

221+ case b of

222+ False -> loop (n-1) (acc `shiftL` 1)

223+ True -> loop (n-1) ((acc `shiftL` 1) + 1)

224+ in loop n0 0

225+

133{-

226{-

134prop_Word32_from_Word8_and_Word16 :: Word8 -> Word16 -> Property

227prop_Word32_from_Word8_and_Word16 :: Word8 -> Word16 -> Property

135prop_Word32_from_Word8_and_Word16 w8 w16 = property $

228prop_Word32_from_Word8_and_Word16 w8 w16 = property $