git.iko.soy/binary-bits
on master help sign in
Add test for Applicative BitGet.
df45a36Lennart Kolmodin
BitsQC.hs+37−4
compare with master
unifiedsplit
@@ -82,6 +82,13 @@ tests =
82 , testProperty "Word64" (prop_putget_list_simple :: W [Word64] -> Property)
82 , testProperty "Word64" (prop_putget_list_simple :: W [Word64] -> Property)
83 ]
83 ]
84
84
85+ , testGroup "prop_putget_applicative_with_bitreq"
86+ [ testProperty "Word8" (prop_putget_applicative_with_bitreq :: W [(Word8,Word8,Word8)] -> Property)
87+ , testProperty "Word16" (prop_putget_applicative_with_bitreq :: W [(Word16,Word16,Word16)] -> Property)
88+ , testProperty "Word32" (prop_putget_applicative_with_bitreq :: W [(Word32,Word32,Word32)] -> Property)
89+ , testProperty "Word64" (prop_putget_applicative_with_bitreq :: W [(Word64,Word64,Word64)] -> Property)
90+ ]
91+
85 , testGroup "prop_putget_list_with_bitreq"
92 , testGroup "prop_putget_list_with_bitreq"
86 [ testProperty "Word8" (prop_putget_list_with_bitreq :: W [Word8] -> Property)
93 [ testProperty "Word8" (prop_putget_list_with_bitreq :: W [Word8] -> Property)
87 , testProperty "Word16" (prop_putget_list_with_bitreq :: W [Word16] -> Property)
94 , testProperty "Word16" (prop_putget_list_with_bitreq :: W [Word16] -> Property)
@@ -129,6 +136,18 @@ prop_putget_list_with_bitreq (W ws) = property $
129 where
136 where
130 bitlist = map bitreq ws
137 bitlist = map bitreq ws
131
138
139+prop_putget_applicative_with_bitreq :: (BinaryBit a, Num a, Bits a, Ord a) => W [(a,a,a)] -> Property
140+prop_putget_applicative_with_bitreq (W ts) = property $
141+ let p = mapM_ (\(a,b,c) -> do putBits (bitreq a) a
142+ putBits (bitreq b) b
143+ putBits (bitreq c) c) ts
144+ g = mapM (\(a,b,c) -> (,,) <$> getBits a <*> getBits b <*> getBits c) bitlist
145+ lbs = runPut (runBitPut p)
146+ ts' = runGet (runBitGet g) lbs
147+ in ts == ts'
148+ where
149+ bitlist = map (\(a,b,c) -> (bitreq a, bitreq b, bitreq c)) ts
150+
132-- | Write bits using this library, and read them back using the binary
151-- | Write bits using this library, and read them back using the binary
133-- library.
152-- library.
134prop_bitput_with_get_from_binary :: (BinaryBit a, Binary a, Storable a, Eq a) => W [a] -> Property
153prop_bitput_with_get_from_binary :: (BinaryBit a, Binary a, Storable a, Eq a) => W [a] -> Property
@@ -235,14 +254,16 @@ shrinker w = [ w `shiftR` 1 -- try to make everything roughly half size
235
254
236data W a = W { unW :: a } deriving (Show, Eq, Ord)
255data W a = W { unW :: a } deriving (Show, Eq, Ord)
237
256
257+arbitraryW :: (Arbitrary (W a)) => Gen a
258+arbitraryW = unW <$> arbitrary
259+
260+shrinkW :: (Arbitrary (W a)) => a -> [a]
261+shrinkW x = unW <$> shrink (W x)
262+
238instance Arbitrary (W Bool) where
263instance Arbitrary (W Bool) where
239 arbitrary = W <$> arbitrary
264 arbitrary = W <$> arbitrary
240 shrink = map W <$> shrink . unW
265 shrink = map W <$> shrink . unW
241
266
242−instance (Arbitrary (W a)) => Arbitrary (W [a]) where
243− arbitrary = W . map unW <$> arbitrary
244− shrink = map (W . map unW) <$> mapM shrink . map W . unW
245−
246instance Arbitrary (W Word8) where
267instance Arbitrary (W Word8) where
247 arbitrary = W <$> choose (minBound, maxBound)
268 arbitrary = W <$> choose (minBound, maxBound)
248 shrink = map W . shrinker . unW
269 shrink = map W . shrinker . unW
@@ -263,6 +284,18 @@ instance Arbitrary B.ByteString where
263 arbitrary = B.pack <$> arbitrary
284 arbitrary = B.pack <$> arbitrary
264 shrink bs = B.pack <$> shrink (B.unpack bs)
285 shrink bs = B.pack <$> shrink (B.unpack bs)
265
286
287+instance (Arbitrary (W a)) => Arbitrary (W [a]) where
288+ arbitrary = W . map unW <$> arbitrary
289+ shrink = map (W . map unW) <$> mapM shrink . map W . unW
290+
291+instance (Arbitrary (W a), Arbitrary (W b)) => Arbitrary (W (a,b)) where
292+ arbitrary = (W .) . (,) <$> arbitraryW <*> arbitraryW
293+ shrink (W (a,b)) = (W .) . (,) <$> shrinkW a <*> shrinkW b
294+
295+instance (Arbitrary (W a), Arbitrary (W b), Arbitrary (W c)) => Arbitrary (W (a,b,c)) where
296+ arbitrary = ((W .) .) . (,,) <$> arbitraryW <*> arbitraryW <*> arbitraryW
297+ shrink (W (a,b,c)) = ((W .) .) . (,,) <$> shrinkW a <*> shrinkW b <*> shrinkW c
298+
266integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
299integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
267integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
300integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
268 fromIntegral b :: Integer) g of
301 fromIntegral b :: Integer) g of