b7c49b1 · binary-bits · git.iko.soy

git.iko.soy/binary-bits

on master help sign in

Add test to read ByteStrings that start with random offsets.

b7c49b1Lennart Kolmodin15 years ago

BitsQC.hs+31−11

compare with master

unifiedsplit

@@ -1,4 +1,4 @@

1−{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}

1+{-# LANGUAGE FlexibleInstances, FlexibleContexts, TupleSections #-}

3module Main where

@@ -13,13 +13,14 @@ import Data.Binary.Bits

13import Data.Binary.Bits.Get

14import Data.Binary.Bits.Put

16+import qualified Data.ByteString as B

17+

16import Control.Applicative

18import Control.Applicative

17import Data.Bits

19import Data.Bits

18import Data.Monoid

20import Data.Monoid

19import Data.Word

21import Data.Word

20import Foreign.Storable

22import Foreign.Storable

21import System.Random

23import System.Random

22−import System

24import Test.Framework.Options ( TestOptions'(..) )

25import Test.Framework.Options ( TestOptions'(..) )

25import Test.Framework.Providers.QuickCheck2 ( testProperty )

26import Test.Framework.Providers.QuickCheck2 ( testProperty )

@@ -85,7 +86,13 @@ tests =

85 [ testProperty "Word8" (prop_putget_list_with_bitreq :: W [Word8] -> Property)

86 [ testProperty "Word8" (prop_putget_list_with_bitreq :: W [Word8] -> Property)

86 , testProperty "Word16" (prop_putget_list_with_bitreq :: W [Word16] -> Property)

87 , testProperty "Word16" (prop_putget_list_with_bitreq :: W [Word16] -> Property)

87 , testProperty "Word32" (prop_putget_list_with_bitreq :: W [Word32] -> Property)

88 , testProperty "Word32" (prop_putget_list_with_bitreq :: W [Word32] -> Property)

88− , testProperty "Word64" (prop_putget_list_with_bitreq :: W [Word64] -> Property)

89+ , testProperty "Word64" (prop_putget_list_with_bitreq :: W [Word64] -> Property)

90+ ]

91+ , testGroup "prop_bitget_bytestring_interspersed"

92+ [ testProperty "Word8" (prop_bitget_bytestring_interspersed :: W Word8 -> [B.ByteString] -> Property)

93+ , testProperty "Word16" (prop_bitget_bytestring_interspersed :: W Word16 -> [B.ByteString] -> Property)

94+ , testProperty "Word32" (prop_bitget_bytestring_interspersed :: W Word32 -> [B.ByteString] -> Property)

95+ , testProperty "Word64" (prop_bitget_bytestring_interspersed :: W Word64 -> [B.ByteString] -> Property)

89 ]

96 ]

90 ]

97 ]

@@ -102,7 +109,7 @@ prop_putget_with_bitreq (W w) = property $

102 let p = putBits (bitreq w) w

109 let p = putBits (bitreq w) w

103 g = getBits (bitreq w)

110 g = getBits (bitreq w)

104 lbs = runPut (runBitPut p)

111 lbs = runPut (runBitPut p)

105− w' = runGet (runBitGetSimple g) lbs

112+ w' = runGet (runBitGet g) lbs

106 in w == w'

113 in w == w'

107

114

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

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

@@ -113,7 +120,7 @@ prop_putget_list_simple (W ws) = property $

113 p = mapM_ (\v -> putBits s v) ws

120 p = mapM_ (\v -> putBits s v) ws

114 g = mapM (const (getBits s)) ws

121 g = mapM (const (getBits s)) ws

115 lbs = runPut (runBitPut p)

122 lbs = runPut (runBitPut p)

116− ws' = runGet (runBitGetSimple g) lbs

123+ ws' = runGet (runBitGet g) lbs

117 in ws == ws'

124 in ws == ws'

118

125

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

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

@@ -124,7 +131,7 @@ prop_putget_list_with_bitreq (W ws) = property $

124 let p = mapM_ (\v -> putBits (bitreq v) v) ws

131 let p = mapM_ (\v -> putBits (bitreq v) v) ws

125 g = mapM getBits bitlist

132 g = mapM getBits bitlist

126 lbs = runPut (runBitPut p)

133 lbs = runPut (runBitPut p)

127− ws' = runGet (runBitGetSimple g) lbs

134+ ws' = runGet (runBitGet g) lbs

128 in ws == ws'

135 in ws == ws'

129 where

136 where

130 bitlist = map bitreq ws

137 bitlist = map bitreq ws

@@ -148,10 +155,19 @@ prop_bitget_with_put_from_binary (W ws) = property $

148 p = mapM_ put ws

155 p = mapM_ put ws

149 g = mapM (const (getBits s)) ws

156 g = mapM (const (getBits s)) ws

150 lbs = runPut p

157 lbs = runPut p

151− ws' = runGet (runBitGetSimple g) lbs

158+ ws' = runGet (runBitGet g) lbs

152 in ws == ws'

159 in ws == ws'

153

160

161+-- | Write each 'ByteString' with a variable sized value as a separator.

162+prop_bitget_bytestring_interspersed :: (BinaryBit a, Binary a, Num a, Ord a, Bits a) => W a -> [B.ByteString] -> Property

163+prop_bitget_bytestring_interspersed (W ws) bss = property $

164+ let p = mapM_ (\bs -> putBits (bitreq ws) ws >> putByteString bs) bss

165+ g = mapM (\bs -> (,) <$> (getBits (bitreq ws)) <*> (getByteString (B.length bs))) bss

166+ lbs = runPut (runBitPut p)

167+ r = runGet (runBitGet g) lbs

168+ in map (ws,) bss == r

169+

154−-- number of bits required to write 'v'

170+-- number of bits required to write @v@

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

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

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

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

157

173

@@ -175,7 +191,7 @@ prop_composite_case b (W w) = w < 0x8000 ==>

175 lsb <- getWord8 8

191 lsb <- getWord8 8

176 return ((fromIntegral msb `shiftL` 8) .|. fromIntegral lsb)

192 return ((fromIntegral msb `shiftL` 8) .|. fromIntegral lsb)

177 lbs = runPut (runBitPut p)

193 lbs = runPut (runBitPut p)

178− w' = runGet (runBitGetSimple g) lbs

194+ w' = runGet (runBitGet g) lbs

179 in w == w'

195 in w == w'

180

196

181

197

@@ -193,8 +209,8 @@ prop_compare_get_with_naive (W ws) = property $

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

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

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

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

195 lbs = runPut (runBitPut p)

211 lbs = runPut (runBitPut p)

196− rn = runGet (runBitGetSimple gn) lbs

212+ rn = runGet (runBitGet gn) lbs

197− r = runGet (runBitGetSimple g ) lbs

213+ r = runGet (runBitGet g ) lbs

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

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

199 types = rn == ws && r == ws

215 types = rn == ws && r == ws

200 in rn == r

216 in rn == r

@@ -272,6 +288,10 @@ instance Arbitrary (W Word64) where

272 arbitrary = W <$> choose (minBound, maxBound)

288 arbitrary = W <$> choose (minBound, maxBound)

273 shrink = map W . shrinker . unW

289 shrink = map W . shrinker . unW

274

290

291+instance Arbitrary B.ByteString where

292+ arbitrary = B.pack <$> arbitrary

293+ shrink bs = B.pack <$> shrink (B.unpack bs)

294+

275integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)

295integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)

276integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,

296integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,

277 fromIntegral b :: Integer) g of

297 fromIntegral b :: Integer) g of