mirror of
https://github.com/ilyakooo0/binary-bits.git
synced 2024-10-26 06:40:48 +03:00
Two more QuickCheck tests
* Write a list of bools and read it back * Write a list of Word8s with variable numbers of bits, and read it back
This commit is contained in:
parent
8897b8930b
commit
53204a2307
27
BitsQC.hs
27
BitsQC.hs
@ -8,7 +8,8 @@ import Data.Bits
|
||||
import Data.Word
|
||||
import System.Random
|
||||
|
||||
import Bits
|
||||
import BitsGet as BG
|
||||
import qualified BitsPut as BP
|
||||
|
||||
import Test.QuickCheck
|
||||
|
||||
@ -18,6 +19,8 @@ main = do
|
||||
quickCheck prop_SimpleCase
|
||||
quickCheck prop_Word32_from_2_Word16
|
||||
quickCheck prop_Word32_from_Word8_and_Word16
|
||||
quickCheck prop_Bools
|
||||
quickCheck prop_Word8_putget
|
||||
|
||||
prop_SimpleCase :: Word16 -> Property
|
||||
prop_SimpleCase w = w < 0x8000 ==>
|
||||
@ -31,6 +34,28 @@ prop_SimpleCase w = w < 0x8000 ==>
|
||||
where
|
||||
lbs = runPut (putWord16be w)
|
||||
|
||||
prop_Word8_putget :: [Word8] -> Property
|
||||
prop_Word8_putget ws = length ws <= fromIntegral (maxBound :: Word8) ==>
|
||||
-- write all word8s with as many bits as it's required
|
||||
let p = mapM_ (\v -> BP.putWord8be (bitreq v) v) ws
|
||||
g = mapM BG.getWord8 bitlist
|
||||
lbs = runPut (BP.runBitPut p)
|
||||
Right ws' = runGet (runBitGet g) lbs
|
||||
in ws == ws'
|
||||
where
|
||||
bitlist = map bitreq ws
|
||||
|
||||
-- number of bits required to write 'v'
|
||||
bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
|
||||
bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..8] ]
|
||||
|
||||
prop_Bools :: [Bool] -> Property
|
||||
prop_Bools bs = property $
|
||||
let p = sequence . replicate (length bs) $ BG.getBool
|
||||
Right bs' = runGet (BG.runBitGet p) lbs
|
||||
in bs == bs'
|
||||
where lbs = runPut $ BP.runBitPut (mapM_ BP.putBool bs)
|
||||
|
||||
prop_Word16be_with_offset :: Word16 -> Property
|
||||
prop_Word16be_with_offset w = w < 0x8000 ==>
|
||||
let b :*: w' :*: w'' = runGet (get (RCheck RBool not "fail" `RNextTo` RWord16be 15 `RNextTo` RWord16be 16)) lbs
|
||||
|
Loading…
Reference in New Issue
Block a user