@@ -3,7 +3,7 @@
33module Main where
44
55import Data.Binary ( encode, Binary(..) )
6−import Data.Binary.Get ( runGet )
6+import Data.Binary.Get ( runGet, runGetPartial, feedLBS, Result(..) )
77import Data.Binary.Put ( runPut )
88
99import qualified Data.Binary.Get as BG ( getWord8, getWord16be, getWord32be, getWord64be )
@@ -43,6 +43,9 @@ tests =
4343 , testGroup "getByteString"
4444 [ testProperty "prop_getByteString_negative" prop_getByteString_negative ]
4545
46+ , testGroup "Fail"
47+ [ testProperty "monadic fail" prop_fail ]
48+
4649 , testGroup "prop_bitput_with_get_from_binary"
4750 [ testProperty "Word8" (prop_bitput_with_get_from_binary :: W [Word8] -> Property)
4851 , testProperty "Word16" (prop_bitput_with_get_from_binary :: W [Word16] -> Property)
@@ -189,6 +192,25 @@ prop_bitget_bytestring_interspersed (W ws) bss = property $
189192 r = runGet (runBitGet g) lbs
190193 in map (ws,) bss == r
191194
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+
192214-- | number of bits required to write @v@
193215bitreq :: (Num b, Bits a, Ord a) => a -> b
194216bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
@@ -294,6 +316,10 @@ instance Arbitrary B.ByteString where
294316 arbitrary = B.pack <$> arbitrary
295317 shrink bs = B.pack <$> shrink (B.unpack bs)
296318
319+instance Arbitrary L.ByteString where
320+ arbitrary = L.fromChunks <$> arbitrary
321+ shrink bs = L.fromChunks <$> shrink (L.toChunks bs)
322+
297323instance (Arbitrary (W a)) => Arbitrary (W [a]) where
298324 arbitrary = W . map unW <$> arbitrary
299325 shrink = map (W . map unW) <$> mapM shrink . map W . unW