git.iko.soy/binary-bits
on master help sign in
Add tests regarding failure and that BitGet has the current chunk.
fe6389eLennart Kolmodin
BitsQC.hs+27−1
compare with master
unifiedsplit
@@ -3,7 +3,7 @@
3module Main where
3module Main where
4
4
5import Data.Binary ( encode, Binary(..) )
5import Data.Binary ( encode, Binary(..) )
6−import Data.Binary.Get ( runGet )
6+import Data.Binary.Get ( runGet, runGetPartial, feedLBS, Result(..) )
7import Data.Binary.Put ( runPut )
7import Data.Binary.Put ( runPut )
8
8
9import qualified Data.Binary.Get as BG ( getWord8, getWord16be, getWord32be, getWord64be )
9import qualified Data.Binary.Get as BG ( getWord8, getWord16be, getWord32be, getWord64be )
@@ -43,6 +43,9 @@ tests =
43 , testGroup "getByteString"
43 , testGroup "getByteString"
44 [ testProperty "prop_getByteString_negative" prop_getByteString_negative ]
44 [ testProperty "prop_getByteString_negative" prop_getByteString_negative ]
45
45
46+ , testGroup "Fail"
47+ [ testProperty "monadic fail" prop_fail ]
48+
46 , testGroup "prop_bitput_with_get_from_binary"
49 , testGroup "prop_bitput_with_get_from_binary"
47 [ testProperty "Word8" (prop_bitput_with_get_from_binary :: W [Word8] -> Property)
50 [ testProperty "Word8" (prop_bitput_with_get_from_binary :: W [Word8] -> Property)
48 , testProperty "Word16" (prop_bitput_with_get_from_binary :: W [Word16] -> Property)
51 , testProperty "Word16" (prop_bitput_with_get_from_binary :: W [Word16] -> Property)
@@ -189,6 +192,25 @@ prop_bitget_bytestring_interspersed (W ws) bss = property $
189 r = runGet (runBitGet g) lbs
192 r = runGet (runBitGet g) lbs
190 in map (ws,) bss == r
193 in map (ws,) bss == r
191
194
195+-- | Test failing.
196+prop_fail :: L.ByteString -> String -> Property
197+prop_fail lbs errMsg0 = forAll (choose (0, 8 * L.length lbs)) $ \len ->
198+ let (bytes,bits) = len `divMod` 8
199+ expectedBytesConsumed
200+ | bits == 0 = bytes
201+ | otherwise = bytes + 1
202+ p = do getByteString (fromIntegral bytes)
203+ getBits (fromIntegral bits) :: BitGet Word8
204+ fail errMsg0
205+ r = runGetPartial (runBitGet p) `feedLBS` lbs
206+ in case r of
207+ Fail remainingBS pos errMsg ->
208+ and [ L.fromChunks [remainingBS] == L.drop expectedBytesConsumed lbs
209+ , pos == expectedBytesConsumed
210+ , errMsg == errMsg0
211+ ]
212+ _ -> False
213+
192-- | number of bits required to write @v@
214-- | number of bits required to write @v@
193bitreq :: (Num b, Bits a, Ord a) => a -> b
215bitreq :: (Num b, Bits a, Ord a) => a -> b
194bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
216bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
@@ -294,6 +316,10 @@ instance Arbitrary B.ByteString where
294 arbitrary = B.pack <$> arbitrary
316 arbitrary = B.pack <$> arbitrary
295 shrink bs = B.pack <$> shrink (B.unpack bs)
317 shrink bs = B.pack <$> shrink (B.unpack bs)
296
318
319+instance Arbitrary L.ByteString where
320+ arbitrary = L.fromChunks <$> arbitrary
321+ shrink bs = L.fromChunks <$> shrink (L.toChunks bs)
322+
297instance (Arbitrary (W a)) => Arbitrary (W [a]) where
323instance (Arbitrary (W a)) => Arbitrary (W [a]) where
298 arbitrary = W . map unW <$> arbitrary
324 arbitrary = W . map unW <$> arbitrary
299 shrink = map (W . map unW) <$> mapM shrink . map W . unW
325 shrink = map (W . map unW) <$> mapM shrink . map W . unW