mirror of
https://github.com/ilyakooo0/binary-bits.git
synced 2024-09-11 06:35:26 +03:00
Enable get/putWord64be, add BinaryBit instance, enable tests
This commit is contained in:
parent
70687bc3e5
commit
7a56f9ef5d
2
Bits.hs
2
Bits.hs
@ -25,8 +25,6 @@ instance BinaryBit Word32 where
|
||||
putBits = putWord32be
|
||||
getBits = getWord32be
|
||||
|
||||
{-
|
||||
instance BinaryBit Word64 where
|
||||
putBits = putWord64be
|
||||
getBits = getWord64be
|
||||
-}
|
||||
|
14
BitsGet.hs
14
BitsGet.hs
@ -11,6 +11,7 @@ module BitsGet
|
||||
, getWord8
|
||||
, getWord16be
|
||||
, getWord32be
|
||||
, getWord64be
|
||||
|
||||
, readBool
|
||||
, readWord8
|
||||
@ -199,7 +200,7 @@ readWord32be s@(S bs o) n
|
||||
| otherwise = error "readWord32be: tried to read more than 32 bits"
|
||||
|
||||
|
||||
readWord64be :: S -> Int -> T Word32 S
|
||||
readWord64be :: S -> Int -> T Word64 S
|
||||
readWord64be s@(S bs o) n
|
||||
-- 8 or fewer bits, use readWord8
|
||||
| n <= 8 = let w :*: s' = readWord8 s n
|
||||
@ -209,9 +210,9 @@ readWord64be s@(S bs o) n
|
||||
| n <= 16 = let w :*: s' = readWord16be s n
|
||||
in fromIntegral w :*: s'
|
||||
|
||||
| o == 0 = readWithoutOffset s shiftl_w32 shiftr_w32 n
|
||||
| o == 0 = readWithoutOffset s shiftl_w64 shiftr_w64 n
|
||||
|
||||
| n <= 64 = readWithOffset s shiftl_w32 shiftr_w32 n
|
||||
| n <= 64 = readWithOffset s shiftl_w64 shiftr_w64 n
|
||||
|
||||
| otherwise = error "readWord64be: tried to read more than 64 bits"
|
||||
|
||||
@ -273,13 +274,16 @@ getBool = ensure 1 >> modifyState readBool
|
||||
|
||||
getWord8 :: Int -> BitGet Word8
|
||||
getWord8 n = ensure n >> modifyState (flip readWord8 n)
|
||||
|
||||
|
||||
getWord16be :: Int -> BitGet Word16
|
||||
getWord16be n = ensure n >> modifyState (flip readWord16be n)
|
||||
|
||||
getWord32be :: Int -> BitGet Word32
|
||||
getWord32be n = ensure n >> modifyState (flip readWord32be n)
|
||||
|
||||
|
||||
getWord64be :: Int -> BitGet Word64
|
||||
getWord64be n = ensure n >> modifyState (flip readWord64be n)
|
||||
|
||||
getState :: BitGet S
|
||||
getState = C $ \s kf ks -> ks s s
|
||||
|
||||
|
@ -28,6 +28,9 @@ data PairS a = PairS a {-# UNPACK #-} !S
|
||||
|
||||
data S = S !Builder !Word8 !Int
|
||||
|
||||
instance Show S where
|
||||
show (S _ w o) = "S( " ++ show w ++ " : " ++ show o ++ ")"
|
||||
|
||||
putBool :: Bool -> BitPut ()
|
||||
putBool b = putWord8 1 (if b then 1 else 0)
|
||||
|
||||
|
14
BitsQC.hs
14
BitsQC.hs
@ -51,35 +51,35 @@ tests =
|
||||
[ testProperty "Word8" (prop_bitput_with_get_from_binary :: [Word8] -> Property)
|
||||
, testProperty "Word16" (prop_bitput_with_get_from_binary :: [Word16] -> Property)
|
||||
, testProperty "Word32" (prop_bitput_with_get_from_binary :: [Word32] -> Property)
|
||||
-- , testProperty "Word64" (prop_bitput_with_get_from_binary :: [Word64] -> Property)
|
||||
, testProperty "Word64" (prop_bitput_with_get_from_binary :: [Word64] -> Property)
|
||||
]
|
||||
|
||||
, testGroup "prop_bitget_with_put_from_binary"
|
||||
[ testProperty "Word8" (prop_bitget_with_put_from_binary :: [Word8] -> Property)
|
||||
, testProperty "Word16" (prop_bitget_with_put_from_binary :: [Word16] -> Property)
|
||||
, testProperty "Word32" (prop_bitget_with_put_from_binary :: [Word32] -> Property)
|
||||
-- , testProperty "Word64" (prop_bitget_with_put_from_binary :: [Word64] -> Property)
|
||||
, testProperty "Word64" (prop_bitget_with_put_from_binary :: [Word64] -> Property)
|
||||
]
|
||||
|
||||
, testGroup "prop_compare_put_with_naive"
|
||||
[ testProperty "Word8" (prop_compare_put_with_naive :: [Word8] -> Property)
|
||||
, testProperty "Word16" (prop_compare_put_with_naive :: [Word16] -> Property)
|
||||
, testProperty "Word32" (prop_compare_put_with_naive :: [Word32] -> Property)
|
||||
-- , testProperty "Word64" (prop_compare_put_with_naive :: [Word64] -> Property)
|
||||
, testProperty "Word64" (prop_compare_put_with_naive :: [Word64] -> Property)
|
||||
]
|
||||
|
||||
, testGroup "prop_compare_get_with_naive"
|
||||
[ testProperty "Word8" (prop_compare_get_with_naive:: [Word8] -> Property)
|
||||
, testProperty "Word16" (prop_compare_get_with_naive:: [Word16] -> Property)
|
||||
, testProperty "Word32" (prop_compare_get_with_naive:: [Word32] -> Property)
|
||||
-- , testProperty "Word64" (prop_compare_get_with_naive:: [Word64] -> Property)
|
||||
, testProperty "Word64" (prop_compare_get_with_naive:: [Word64] -> Property)
|
||||
]
|
||||
|
||||
, testGroup "prop_put_with_bitreq"
|
||||
[ testProperty "Word8" (prop_putget_with_bitreq :: Word8 -> Property)
|
||||
, testProperty "Word16" (prop_putget_with_bitreq :: Word16 -> Property)
|
||||
, testProperty "Word32" (prop_putget_with_bitreq :: Word32 -> Property)
|
||||
-- , testProperty "Word64" (prop_putget_with_bitreq :: Word64 -> Property)
|
||||
, testProperty "Word64" (prop_putget_with_bitreq :: Word64 -> Property)
|
||||
]
|
||||
|
||||
, testGroup "prop_putget_list_simple"
|
||||
@ -87,14 +87,14 @@ tests =
|
||||
, testProperty "Word8" (prop_putget_list_simple :: [Word8] -> Property)
|
||||
, testProperty "Word16" (prop_putget_list_simple :: [Word16] -> Property)
|
||||
, testProperty "Word32" (prop_putget_list_simple :: [Word32] -> Property)
|
||||
-- , testProperty "Word64" (prop_putget_list_simple :: [Word64] -> Property)
|
||||
, testProperty "Word64" (prop_putget_list_simple :: [Word64] -> Property)
|
||||
]
|
||||
|
||||
, testGroup "prop_putget_list_with_bitreq"
|
||||
[ testProperty "Word8" (prop_putget_list_with_bitreq :: [Word8] -> Property)
|
||||
, testProperty "Word16" (prop_putget_list_with_bitreq :: [Word16] -> Property)
|
||||
, testProperty "Word32" (prop_putget_list_with_bitreq :: [Word32] -> Property)
|
||||
-- , testProperty "Word64" (prop_putget_list_with_bitreq :: [Word64] -> Property)
|
||||
, testProperty "Word64" (prop_putget_list_with_bitreq :: [Word64] -> Property)
|
||||
]
|
||||
]
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user