@@ -1,4 +1,4 @@
1−{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
1+{-# LANGUAGE FlexibleInstances, FlexibleContexts, TupleSections #-}
22
33module Main where
44
@@ -13,13 +13,14 @@ import Data.Binary.Bits
1313import Data.Binary.Bits.Get
1414import Data.Binary.Bits.Put
1515
16+import qualified Data.ByteString as B
17+
1618import Control.Applicative
1719import Data.Bits
1820import Data.Monoid
1921import Data.Word
2022import Foreign.Storable
2123import System.Random
22−import System
2324
2425import Test.Framework.Options ( TestOptions'(..) )
2526import Test.Framework.Providers.QuickCheck2 ( testProperty )
@@ -85,7 +86,13 @@ tests =
8586 [ testProperty "Word8" (prop_putget_list_with_bitreq :: W [Word8] -> Property)
8687 , testProperty "Word16" (prop_putget_list_with_bitreq :: W [Word16] -> Property)
8788 , 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)
8996 ]
9097 ]
9198
@@ -102,7 +109,7 @@ prop_putget_with_bitreq (W w) = property $
102109 let p = putBits (bitreq w) w
103110 g = getBits (bitreq w)
104111 lbs = runPut (runBitPut p)
105− w' = runGet (runBitGetSimple g) lbs
112+ w' = runGet (runBitGet g) lbs
106113 in w == w'
107114
108115-- | 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 $
113120 p = mapM_ (\v -> putBits s v) ws
114121 g = mapM (const (getBits s)) ws
115122 lbs = runPut (runBitPut p)
116− ws' = runGet (runBitGetSimple g) lbs
123+ ws' = runGet (runBitGet g) lbs
117124 in ws == ws'
118125
119126-- | 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 $
124131 let p = mapM_ (\v -> putBits (bitreq v) v) ws
125132 g = mapM getBits bitlist
126133 lbs = runPut (runBitPut p)
127− ws' = runGet (runBitGetSimple g) lbs
134+ ws' = runGet (runBitGet g) lbs
128135 in ws == ws'
129136 where
130137 bitlist = map bitreq ws
@@ -148,10 +155,19 @@ prop_bitget_with_put_from_binary (W ws) = property $
148155 p = mapM_ put ws
149156 g = mapM (const (getBits s)) ws
150157 lbs = runPut p
151− ws' = runGet (runBitGetSimple g) lbs
158+ ws' = runGet (runBitGet g) lbs
152159 in ws == ws'
153160
154−-- number of bits required to write 'v'
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+
170+-- number of bits required to write @v@
155171bitreq :: (Num b, Bits a, Ord a) => a -> b
156172bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
157173
@@ -175,7 +191,7 @@ prop_composite_case b (W w) = w < 0x8000 ==>
175191 lsb <- getWord8 8
176192 return ((fromIntegral msb `shiftL` 8) .|. fromIntegral lsb)
177193 lbs = runPut (runBitPut p)
178− w' = runGet (runBitGetSimple g) lbs
194+ w' = runGet (runBitGet g) lbs
179195 in w == w'
180196
181197
@@ -193,8 +209,8 @@ prop_compare_get_with_naive (W ws) = property $
193209 g = mapM (\v -> getBits (bitreq v)) ws
194210 p = mapM_ (\v -> naive_put (bitreq v) v) ws
195211 lbs = runPut (runBitPut p)
196− rn = runGet (runBitGetSimple gn) lbs
197− r = runGet (runBitGetSimple g ) lbs
212+ rn = runGet (runBitGet gn) lbs
213+ r = runGet (runBitGet g ) lbs
198214 -- we must help our compiler to resolve the types of 'gn' and 'g'
199215 types = rn == ws && r == ws
200216 in rn == r
@@ -272,6 +288,10 @@ instance Arbitrary (W Word64) where
272288 arbitrary = W <$> choose (minBound, maxBound)
273289 shrink = map W . shrinker . unW
274290
291+instance Arbitrary B.ByteString where
292+ arbitrary = B.pack <$> arbitrary
293+ shrink bs = B.pack <$> shrink (B.unpack bs)
294+
275295integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
276296integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
277297 fromIntegral b :: Integer) g of