ilyakooo0/binary-bits
1
0
Fork 0
mirror of https://github.com/ilyakooo0/binary-bits.git synced 2024-10-26 06:40:48 +03:00
Code Issues Packages Projects Releases Wiki Activity

Add tests regarding failure and that BitGet has the current chunk.

Browse Source
This commit is contained in:
Lennart Kolmodin 2012-04-25 21:42:03 +04:00
parent 0e5029eff1
commit fe6389e97a
1 changed files with 27 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
BitsQC.hs
View File

@ -3,7 +3,7 @@
module Main where module Main where
import Data.Binary ( encode, Binary(..) ) import Data.Binary ( encode, Binary(..) )
import Data.Binary.Get ( runGet ) import Data.Binary.Get ( runGet, runGetPartial, feedLBS, Result(..) )
import Data.Binary.Put ( runPut ) import Data.Binary.Put ( runPut )
import qualified Data.Binary.Get as BG ( getWord8, getWord16be, getWord32be, getWord64be ) import qualified Data.Binary.Get as BG ( getWord8, getWord16be, getWord32be, getWord64be )
@ -43,6 +43,9 @@ tests =
, testGroup "getByteString" , testGroup "getByteString"
[ testProperty "prop_getByteString_negative" prop_getByteString_negative ] [ testProperty "prop_getByteString_negative" prop_getByteString_negative ]
, testGroup "Fail"
[ testProperty "monadic fail" prop_fail ]
, testGroup "prop_bitput_with_get_from_binary" , testGroup "prop_bitput_with_get_from_binary"
[ testProperty "Word8" (prop_bitput_with_get_from_binary :: W [Word8] -> Property) [ testProperty "Word8" (prop_bitput_with_get_from_binary :: W [Word8] -> Property)
, testProperty "Word16" (prop_bitput_with_get_from_binary :: W [Word16] -> Property) , testProperty "Word16" (prop_bitput_with_get_from_binary :: W [Word16] -> Property)
@ -189,6 +192,25 @@ prop_bitget_bytestring_interspersed (W ws) bss = property $
r = runGet (runBitGet g) lbs r = runGet (runBitGet g) lbs
in map (ws,) bss == r in map (ws,) bss == r
-- | Test failing.
prop_fail :: L.ByteString -> String -> Property
prop_fail lbs errMsg0 = forAll (choose (0, 8 * L.length lbs)) $ \len ->
let (bytes,bits) = len `divMod` 8
expectedBytesConsumed
| bits == 0 = bytes
| otherwise = bytes + 1
p = do getByteString (fromIntegral bytes)
getBits (fromIntegral bits) :: BitGet Word8
fail errMsg0
r = runGetPartial (runBitGet p) `feedLBS` lbs
in case r of
Fail remainingBS pos errMsg ->
and [ L.fromChunks [remainingBS] == L.drop expectedBytesConsumed lbs
, pos == expectedBytesConsumed
, errMsg == errMsg0
]
_ -> False
-- | number of bits required to write @v@ -- | number of bits required to write @v@
bitreq :: (Num b, Bits a, Ord a) => a -> b bitreq :: (Num b, Bits a, Ord a) => a -> b
bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ] bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
@ -294,6 +316,10 @@ instance Arbitrary B.ByteString where
arbitrary = B.pack <$> arbitrary arbitrary = B.pack <$> arbitrary
shrink bs = B.pack <$> shrink (B.unpack bs) shrink bs = B.pack <$> shrink (B.unpack bs)
instance Arbitrary L.ByteString where
arbitrary = L.fromChunks <$> arbitrary
shrink bs = L.fromChunks <$> shrink (L.toChunks bs)
instance (Arbitrary (W a)) => Arbitrary (W [a]) where instance (Arbitrary (W a)) => Arbitrary (W [a]) where
arbitrary = W . map unW <$> arbitrary arbitrary = W . map unW <$> arbitrary
shrink = map (W . map unW) <$> mapM shrink . map W . unW shrink = map (W . map unW) <$> mapM shrink . map W . unW