git.iko.soy/binary-bits
on 858e615 help sign in
binary-bits/BitsQC.hs
549 lines 21 kB history raw
1{-# LANGUAGE CPP, FlexibleInstances, FlexibleContexts, TupleSections #-}
3module Main ( main ) where
5import Data.Binary ( Binary(..) )
6import Data.Binary.Get ( runGet, runGetIncremental, pushChunks, Decoder(..) )
7import Data.Binary.Put ( runPut )
9import Data.Binary.Bits
10import Data.Binary.Bits.Get
11import Data.Binary.Bits.Put
12import Data.Binary.Bits.BitOrder
14import qualified Data.ByteString as B
15import qualified Data.ByteString.Lazy as L
17import Control.Applicative
18import Data.Bits
19import Data.Word
20import Foreign.Storable
21import Data.Traversable (traverse)
22import Data.Foldable (traverse_)
24import Test.Framework.Providers.QuickCheck2 ( testProperty )
25import Test.Framework.Runners.Console ( defaultMain )
26import Test.Framework ( Test, testGroup )
27import Test.QuickCheck
29main :: IO ()
30main = defaultMain tests
32tests :: [Test]
33tests =
34 [ testGroup "Internal test functions"
35 [ testProperty "prop_bitreq" prop_bitreq ]
37 , testGroup "Custom test cases"
38 [ testProperty "prop_composite_case" prop_composite_case ]
40 , testGroup "getByteString"
41 [ testProperty "prop_getByteString_negative" prop_getByteString_negative
42 , testProperty "prop_putByteString_getByteString" (prop_putByteString_getByteString :: BitOrder -> B.ByteString -> Property)
43 , testProperty "prop_putByteString_getByteString_many" (prop_putByteString_getByteString_many :: BitOrder -> [B.ByteString] -> Property)
44 ]
46 , testGroup "getLazyByteString"
47 [ testProperty "getLazyByteString == getByteString"
48 prop_getLazyByteString_equal_to_ByteString
49 , testProperty "getLazyByteString == getByteString (with shift)"
50 prop_getLazyByteString_equal_to_ByteString2
51 ]
53 , testGroup "isEmpty"
54 [ testProperty "prop_isEmptyOfEmptyEmpty" prop_isEmptyOfEmptyEmpty
55 , testProperty "prop_isEmptyOfNonEmptyEmpty" prop_isEmptyOfNonEmptyEmpty
56 , testProperty "prop_isEmptyOfConsumedEmpty" prop_isEmptyOfConsumedEmpty
57 , testProperty "prop_isEmptyOfNotConsumedNotEmpty" prop_isEmptyOfNotConsumedNotEmpty
58 ]
60 , testGroup "Fail"
61 [ testProperty "monadic fail" prop_fail ]
63 , testGroup "prop_bitput_with_get_from_binary"
64 [ testProperty "Word8" (prop_bitput_with_get_from_binary :: W [Word8] -> Property)
65 , testProperty "Word16" (prop_bitput_with_get_from_binary :: W [Word16] -> Property)
66 , testProperty "Word32" (prop_bitput_with_get_from_binary :: W [Word32] -> Property)
67 , testProperty "Word64" (prop_bitput_with_get_from_binary :: W [Word64] -> Property)
68 ]
70 , testGroup "prop_bitget_with_put_from_binary"
71 [ testProperty "Word8" (prop_bitget_with_put_from_binary :: W [Word8] -> Property)
72 , testProperty "Word16" (prop_bitget_with_put_from_binary :: W [Word16] -> Property)
73 , testProperty "Word32" (prop_bitget_with_put_from_binary :: W [Word32] -> Property)
74 , testProperty "Word64" (prop_bitget_with_put_from_binary :: W [Word64] -> Property)
75 ]
77 , testGroup "prop_compare_put_with_naive"
78 [ testProperty "Word8" (prop_compare_put_with_naive :: W [Word8] -> Property)
79 , testProperty "Word16" (prop_compare_put_with_naive :: W [Word16] -> Property)
80 , testProperty "Word32" (prop_compare_put_with_naive :: W [Word32] -> Property)
81 , testProperty "Word64" (prop_compare_put_with_naive :: W [Word64] -> Property)
82 ]
84 , testGroup "prop_compare_get_with_naive"
85 [ testProperty "Word8" (prop_compare_get_with_naive:: W [Word8] -> Property)
86 , testProperty "Word16" (prop_compare_get_with_naive:: W [Word16] -> Property)
87 , testProperty "Word32" (prop_compare_get_with_naive:: W [Word32] -> Property)
88 , testProperty "Word64" (prop_compare_get_with_naive:: W [Word64] -> Property)
89 ]
91 , testGroup "prop_put_with_bitreq"
92 [ testProperty "Word8" (prop_putget_with_bitreq :: BitOrder -> W Word8 -> Property)
93 , testProperty "Word16" (prop_putget_with_bitreq :: BitOrder -> W Word16 -> Property)
94 , testProperty "Word32" (prop_putget_with_bitreq :: BitOrder -> W Word32 -> Property)
95 , testProperty "Word64" (prop_putget_with_bitreq :: BitOrder -> W Word64 -> Property)
96 ]
98 , testGroup "prop_putget_list_simple"
99 [ testProperty "Bool" (prop_putget_list_simple :: W [Bool] -> Property)
100 , testProperty "Word8" (prop_putget_list_simple :: W [Word8] -> Property)
101 , testProperty "Word16" (prop_putget_list_simple :: W [Word16] -> Property)
102 , testProperty "Word32" (prop_putget_list_simple :: W [Word32] -> Property)
103 , testProperty "Word64" (prop_putget_list_simple :: W [Word64] -> Property)
104 ]
106 , testGroup "prop_putget_applicative_with_bitreq"
107 [ testProperty "Word8" (prop_putget_applicative_with_bitreq :: W [(Word8,Word8,Word8)] -> Property)
108 , testProperty "Word16" (prop_putget_applicative_with_bitreq :: W [(Word16,Word16,Word16)] -> Property)
109 , testProperty "Word32" (prop_putget_applicative_with_bitreq :: W [(Word32,Word32,Word32)] -> Property)
110 , testProperty "Word64" (prop_putget_applicative_with_bitreq :: W [(Word64,Word64,Word64)] -> Property)
111 ]
113 , testGroup "prop_putget_list_with_bitreq"
114 [ testProperty "Word8" (prop_putget_list_with_bitreq :: W [Word8] -> Property)
115 , testProperty "Word16" (prop_putget_list_with_bitreq :: W [Word16] -> Property)
116 , testProperty "Word32" (prop_putget_list_with_bitreq :: W [Word32] -> Property)
117 , testProperty "Word64" (prop_putget_list_with_bitreq :: W [Word64] -> Property)
118 ]
119 , testGroup "prop_bitget_bytestring_interspersed"
120 [ testProperty "Word8" (prop_bitget_bytestring_interspersed :: BitOrder -> W Word8 -> [B.ByteString] -> Property)
121 , testProperty "Word16" (prop_bitget_bytestring_interspersed :: BitOrder -> W Word16 -> [B.ByteString] -> Property)
122 , testProperty "Word32" (prop_bitget_bytestring_interspersed :: BitOrder -> W Word32 -> [B.ByteString] -> Property)
123 , testProperty "Word64" (prop_bitget_bytestring_interspersed :: BitOrder -> W Word64 -> [B.ByteString] -> Property)
124 ]
125 , testGroup "Simulate programs"
126 [ testProperty "primitive" prop_primitive
127 , testProperty "many primitives in sequence" prop_program
128 ]
129 ]
131prop_isEmptyOfEmptyEmpty :: Bool
132prop_isEmptyOfEmptyEmpty = runGet (runBitGet isEmpty) L.empty
134prop_isEmptyOfNonEmptyEmpty :: L.ByteString -> Property
135prop_isEmptyOfNonEmptyEmpty bs =
136 not (L.null bs) ==> not (runGet (runBitGet isEmpty) bs)
138prop_isEmptyOfConsumedEmpty :: L.ByteString -> Property
139prop_isEmptyOfConsumedEmpty bs =
140 not (L.null bs) ==>
141 runGet (runBitGet (getByteString n >> isEmpty)) bs
142 where n = fromIntegral $ L.length bs
144prop_isEmptyOfNotConsumedNotEmpty :: L.ByteString -> Int -> Property
145prop_isEmptyOfNotConsumedNotEmpty bs n =
146 (fromIntegral n) < L.length bs && not (L.null bs) ==>
147 not (runGet (runBitGet (getByteString n >> isEmpty)) bs)
149prop_getLazyByteString_equal_to_ByteString :: L.ByteString -> Int -> Property
150prop_getLazyByteString_equal_to_ByteString bs n =
151 (fromIntegral n) <= L.length bs ==>
152 runGet (runBitGet (getLazyByteString (fromIntegral n))) bs ==
153 (L.fromChunks . (:[]) $ runGet (runBitGet (getByteString n)) bs)
155prop_getLazyByteString_equal_to_ByteString2 :: L.ByteString -> Int -> Property
156prop_getLazyByteString_equal_to_ByteString2 bs n =
157 (L.length bs > 1) && (fromIntegral n) < L.length bs ==>
158 runGet (runBitGet (getWord8 2 >> getLazyByteString (fromIntegral n))) bs ==
159 (L.fromChunks . (:[]) $ runGet (runBitGet (getWord8 2 >> getByteString n)) bs)
161prop_getByteString_negative :: Int -> Property
162prop_getByteString_negative n =
163 n < 1 ==>
164 runGet (runBitGet (getByteString n)) L.empty == B.empty
166prop_putByteString_getByteString :: BitOrder -> B.ByteString -> Property
167prop_putByteString_getByteString bo bs = property $ bs' == bs
168 where
169 n = B.length bs
170 w = runPut (runBitPut (withBitOrder bo (putByteString bs)))
171 bs' = runGet (runBitGet (withBitOrder bo (getByteString n))) w
173prop_putByteString_getByteString_many :: BitOrder -> [B.ByteString] -> Property
174prop_putByteString_getByteString_many bo bs = property $ bs' == bs
175 where
176 n = fmap B.length bs
177 w = runPut (runBitPut (withBitOrder bo (traverse_ putByteString bs)))
178 bs' = runGet (runBitGet (withBitOrder bo (traverse getByteString n))) w
181prop_putget_with_bitreq :: (BinaryBit a, Num a, Bits a, Ord a) => BitOrder -> W a -> Property
182prop_putget_with_bitreq bo (W w) = property $
183 -- write all words with as many bits as it's required
184 let p = putBits (bitreq w) w
185 g = getBits (bitreq w)
186 lbs = runPut (runBitPut (withBitOrder bo p))
187 w' = runGet (runBitGet (withBitOrder bo g)) lbs
188 in w == w'
190-- | Write a list of items. Each item is written with the maximum amount of
191-- bits, i.e. 8 for Word8, 16 for Word16, etc.
192prop_putget_list_simple :: (BinaryBit a, Eq a, Storable a) => W [a] -> Property
193prop_putget_list_simple (W ws) = property $
194 let s = sizeOf (head ws) * 8
195 p = mapM_ (putBits s) ws
196 g = mapM (const (getBits s)) ws
197 lbs = runPut (runBitPut p)
198 ws' = runGet (runBitGet g) lbs
199 in ws == ws'
201-- | Write a list of items. Each item is written with exactly as many bits
202-- as required. Then read it back.
203prop_putget_list_with_bitreq :: (BinaryBit a, Num a, Bits a, Ord a) => W [a] -> Property
204prop_putget_list_with_bitreq (W ws) = property $
205 -- write all words with as many bits as it's required
206 let p = mapM_ (\v -> putBits (bitreq v) v) ws
207 g = mapM getBits bitlist
208 lbs = runPut (runBitPut p)
209 ws' = runGet (runBitGet g) lbs
210 in ws == ws'
211 where
212 bitlist = map bitreq ws
214prop_putget_applicative_with_bitreq :: (BinaryBit a, Num a, Bits a, Ord a) => W [(a,a,a)] -> Property
215prop_putget_applicative_with_bitreq (W ts) = property $
216 let p = mapM_ (\(a,b,c) -> do putBits (bitreq a) a
217 putBits (bitreq b) b
218 putBits (bitreq c) c) ts
219 g = mapM (\(a,b,c) -> (,,) <$> getBits a <*> getBits b <*> getBits c) bitlist
220 lbs = runPut (runBitPut p)
221 ts' = runGet (runBitGet g) lbs
222 in ts == ts'
223 where
224 bitlist = map (\(a,b,c) -> (bitreq a, bitreq b, bitreq c)) ts
226-- | Write bits using this library, and read them back using the binary
227-- library.
228prop_bitput_with_get_from_binary :: (BinaryBit a, Binary a, Storable a, Eq a) => W [a] -> Property
229prop_bitput_with_get_from_binary (W ws) = property $
230 let s = sizeOf (head ws) * 8
231 p = mapM_ (putBits s) ws
232 g = mapM (const get) ws
233 lbs = runPut (runBitPut p)
234 ws' = runGet g lbs
235 in ws == ws'
237-- | Write bits using the binary library, and read them back using this
238-- library.
239prop_bitget_with_put_from_binary :: (BinaryBit a, Binary a, Storable a, Eq a) => W [a] -> Property
240prop_bitget_with_put_from_binary (W ws) = property $
241 let s = sizeOf (head ws) * 8
242 p = mapM_ put ws
243 g = mapM (const (getBits s)) ws
244 lbs = runPut p
245 ws' = runGet (runBitGet g) lbs
246 in ws == ws'
248-- | Write each 'ByteString' with a variable sized value as a separator.
249prop_bitget_bytestring_interspersed :: (BinaryBit a, Binary a, Num a, Ord a, Bits a) => BitOrder -> W a -> [B.ByteString] -> Property
250prop_bitget_bytestring_interspersed bo (W ws) bss = property $
251 let p = mapM_ (\bs -> putBits (bitreq ws) ws >> putByteString bs) bss
252 g = mapM (\bs -> (,) <$> getBits (bitreq ws) <*> getByteString (B.length bs)) bss
253 lbs = runPut (runBitPut (withBitOrder bo p))
254 r = runGet (runBitGet (withBitOrder bo g)) lbs
255 in map (ws,) bss == r
257-- | Test failing.
258prop_fail :: L.ByteString -> String -> Property
259prop_fail lbs errMsg0 = forAll (choose (0, 8 * L.length lbs)) $ \len ->
260 let (bytes,bits) = len `divMod` 8
261 expectedBytesConsumed
262 | bits == 0 = bytes
263 | otherwise = bytes + 1
264 p = do _ <- getByteString (fromIntegral bytes)
265 _ <- getBits (fromIntegral bits) :: BitGet Word8
266 fail errMsg0
267 r = runGetIncremental (runBitGet p) `pushChunks` lbs
268 in case r of
269 Fail remainingBS pos errMsg ->
270 and [ L.fromChunks [remainingBS] == L.drop expectedBytesConsumed lbs
271 , pos == expectedBytesConsumed
272 , errMsg == errMsg0
273 ]
274 _ -> False
276-- | number of bits required to write @v@
277bitreq :: (Num b, Num a, Bits a, Ord a) => a -> b
278bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
280bittable :: (Bits a, Num a) => [(Integer, a)]
281bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..64] ]
283prop_bitreq :: W Word64 -> Property
284prop_bitreq (W w) = property $
285 ( w == 0 && bitreq w == 1 )
286 || bitreq w == bitreq (w `shiftR` 1) + 1
288prop_composite_case :: Bool -> W Word16 -> Property
289prop_composite_case b (W w) = w < 0x8000 ==>
290 let p = do putBool b
291 putWord16 15 w
292 g = do v <- getBool
293 case v of
294 True -> getWord16 15
295 False -> do
296 msb <- getWord8 7
297 lsb <- getWord8 8
298 return ((fromIntegral msb `shiftL` 8) .|. fromIntegral lsb)
299 lbs = runPut (runBitPut p)
300 w' = runGet (runBitGet g) lbs
301 in w == w'
303prop_compare_put_with_naive :: (Bits a, BinaryBit a, Ord a, Num a) => W [a] -> Property
304prop_compare_put_with_naive (W ws) = property $
305 let pn = mapM_ (\v -> naive_put (bitreq v) v) ws
306 p = mapM_ (\v -> putBits (bitreq v) v) ws
307 lbs_n = runPut (runBitPut pn)
308 lbs = runPut (runBitPut p)
309 in lbs_n == lbs
311prop_compare_get_with_naive :: (Bits a, BinaryBit a, Ord a, Num a) => W [a] -> Property
312prop_compare_get_with_naive (W ws) = property $
313 let gn = mapM (\v -> naive_get (bitreq v)) ws
314 g = mapM (\v -> getBits (bitreq v)) ws
315 p = mapM_ (\v -> naive_put (bitreq v) v) ws
316 lbs = runPut (runBitPut p)
317 rn = runGet (runBitGet gn) lbs
318 r = runGet (runBitGet g ) lbs
319 -- we must help our compiler to resolve the types of 'gn' and 'g'
320 _types = rn == ws && r == ws
321 in rn == r
323-- | Write one bit at a time until the full word has been written
324naive_put :: (Bits a) => Int -> a -> BitPut ()
325naive_put n w = mapM_ (\b -> putBool (testBit w b)) [n-1,n-2..0]
327-- | Read one bit at a time until we've reconstructed the whole word
328naive_get :: (Bits a, Num a) => Int -> BitGet a
329naive_get n0 =
330 let loop 0 acc = return acc
331 loop n acc = do
332 b <- getBool
333 case b of
334 False -> loop (n-1) (acc `shiftL` 1)
335 True -> loop (n-1) ((acc `shiftL` 1) + 1)
336 in loop n0 0
338shrinker :: (Num a, Ord a, Bits a) => a -> [a]
339shrinker 0 = []
340shrinker w = [ w `shiftR` 1 -- try to make everything roughly half size
341 ] ++ [ w' -- flip bits to zero, left->right
342 | m <- [n, n-1..1]
343 , let w' = w `clearBit` m
344 , w /= w'
345 ] ++ [w-1] -- just make it a little smaller
346 where
347 n = bitreq w
349data W a = W { unW :: a } deriving (Show, Eq, Ord)
351arbitraryW :: (Arbitrary (W a)) => Gen a
352arbitraryW = unW <$> arbitrary
354shrinkW :: (Arbitrary (W a)) => a -> [a]
355shrinkW x = unW <$> shrink (W x)
357instance Arbitrary (W Bool) where
358 arbitrary = W <$> arbitrary
359 shrink = map W <$> shrink . unW
361instance Arbitrary (W Word8) where
362 arbitrary = W <$> choose (minBound, maxBound)
363 shrink = map W . shrinker . unW
365instance Arbitrary (W Word16) where
366 arbitrary = W <$> choose (minBound, maxBound)
367 shrink = map W . shrinker . unW
369instance Arbitrary (W Word32) where
370 arbitrary = W <$> choose (minBound, maxBound)
371 shrink = map W . shrinker . unW
373instance Arbitrary (W Word64) where
374 arbitrary = W <$> choose (minBound, maxBound)
375 shrink = map W . shrinker . unW
377instance Arbitrary B.ByteString where
378 arbitrary = B.pack <$> arbitrary
379 shrink bs = B.pack <$> shrink (B.unpack bs)
381instance Arbitrary L.ByteString where
382 arbitrary = L.fromChunks <$> arbitrary
383 shrink bs = L.fromChunks <$> shrink (L.toChunks bs)
385instance (Arbitrary (W a)) => Arbitrary (W [a]) where
386 arbitrary = W . map unW <$> arbitrary
387 shrink = map (W . map unW) <$> mapM shrink . map W . unW
389instance (Arbitrary (W a), Arbitrary (W b)) => Arbitrary (W (a,b)) where
390 arbitrary = (W .) . (,) <$> arbitraryW <*> arbitraryW
391 shrink (W (a,b)) = (W .) . (,) <$> shrinkW a <*> shrinkW b
393instance (Arbitrary (W a), Arbitrary (W b), Arbitrary (W c)) => Arbitrary (W (a,b,c)) where
394 arbitrary = ((W .) .) . (,,) <$> arbitraryW <*> arbitraryW <*> arbitraryW
395 shrink (W (a,b,c)) = ((W .) .) . (,,) <$> shrinkW a <*> shrinkW b <*> shrinkW c
397data Primitive
398 = Bool Bool
399 | W8 Int Word8
400 | W16 Int Word16
401 | W32 Int Word32
402 | W64 Int Word64
403 | BS Int B.ByteString
404 | LBS Int L.ByteString
405 | Skip Int
406 | IsEmpty
407 deriving (Eq, Show)
409type Program = [Primitive]
411instance Arbitrary Primitive where
412 arbitrary = do
413 let gen c = do
414 let (maxBits, _) = (\w -> (finiteBitSize w, c undefined w)) undefined
415 bits <- choose (0, maxBits)
416 n <- choose (0, fromIntegral (2^bits-1))
417 return (c bits n)
418 oneof
419 [ Bool <$> arbitrary
420 , gen W8
421 , gen W16
422 , gen W32
423 , gen W64
424 , Skip <$> choose (0, 3000)
425 , do n <- choose (0,10)
426 cs <- vector n
427 return (BS n (B.pack cs))
428 , do n <- choose (0,10)
429 cs <- vector n
430 return (LBS n (L.pack cs))
431 , return IsEmpty
432 ]
433 shrink p =
434 let snk c x = map (\x' -> c (bitreq x') x') (shrinker x) in
435 case p of
436 Bool b -> if b then [Bool False] else []
437 W8 _ x -> snk W8 x
438 W16 _ x -> snk W16 x
439 W32 _ x -> snk W32 x
440 W64 _ x -> snk W64 x
441 Skip x -> Skip <$> shrink x
442 BS _ bs -> let ws = B.unpack bs in map (\ws' -> BS (length ws') (B.pack ws')) (shrink ws)
443 LBS _ lbs -> let ws = L.unpack lbs in map (\ws' -> LBS (length ws') (L.pack ws')) (shrink ws)
444 IsEmpty -> []
446instance Arbitrary BitOrder where
447 arbitrary = elements [BB, LB, LL, BL]
448 shrink LL = [BB,LB,BL]
449 shrink BL = [BB,LB]
450 shrink LB = [BB]
451 shrink BB = []
454prop_primitive :: Primitive -> Property
455prop_primitive prim = property $
456 let p = putPrimitive prim
457 g = getPrimitive prim
458 lbs = runPut (runBitPut p)
459 r = runGet (runBitGet g) lbs
460 in r == prim
462prop_program :: Program -> Property
463prop_program program = property $
464 let p = mapM_ putPrimitive program
465 g = verifyProgram (8 * fromIntegral (L.length lbs)) program
466 lbs = runPut (runBitPut p)
467 r = runGet (runBitGet g) lbs
468 in r
470putPrimitive :: Primitive -> BitPut ()
471putPrimitive p =
472 case p of
473 Bool b -> putBool b
474 W8 n x -> putWord8 n x
475 W16 n x -> putWord16 n x
476 W32 n x -> putWord32 n x
477 W64 n x -> putWord64 n x
478 Skip n -> skipBits n
479 BS _ bs -> putByteString bs
480 LBS _ lbs -> mapM_ putByteString (L.toChunks lbs)
481 IsEmpty -> return ()
483getPrimitive :: Primitive -> BitGet Primitive
484getPrimitive p =
485 case p of
486 Bool _ -> Bool <$> getBool
487 W8 n _ -> W8 n <$> getWord8 n
488 W16 n _ -> W16 n <$> getWord16 n
489 W32 n _ -> W32 n <$> getWord32 n
490 W64 n _ -> W64 n <$> getWord64 n
491 Skip n -> skipBits n >> return (Skip n)
492 BS n _ -> BS n <$> getByteString n
493 LBS n _ -> LBS n <$> getLazyByteString n
494 IsEmpty -> isEmpty >> return IsEmpty
496getPrimitiveSize :: Primitive -> Int
497getPrimitiveSize p = case p of
498 Bool _ -> 1
499 W8 n _ -> n
500 W16 n _ -> n
501 W32 n _ -> n
502 W64 n _ -> n
503 Skip n -> n
504 BS n _ -> n*8
505 LBS n _ -> n*8
506 IsEmpty -> 0
508verifyProgram :: Int -> Program -> BitGet Bool
509verifyProgram totalLength ps0 = go 0 ps0
510 where
511 go _ [] = return True
512 go pos (p:ps) =
513 case p of
514 IsEmpty -> do
515 let expected = pos == totalLength
516 actual <- isEmpty
517 if expected == actual
518 then go pos ps
519 else error $ "isEmpty returned wrong value, expected "
520 ++ show expected ++ " but got " ++ show actual
521 _ -> check p (getPrimitive p) >> go (pos + getPrimitiveSize p) ps
522 check x g = do
523 y <- g
524 if x == y
525 then return ()
526 else error $ "Roundtrip error: Expected "
527 ++ show x ++ " but got " ++ show y
529{-
530instance Random Word where
531 randomR = integralRandomR
532 random = randomR (minBound,maxBound)
534instance Random Word8 where
535 randomR = integralRandomR
536 random = randomR (minBound,maxBound)
538instance Random Word16 where
539 randomR = integralRandomR
540 random = randomR (minBound,maxBound)
542instance Random Word32 where
543 randomR = integralRandomR
544 random = randomR (minBound,maxBound)
546instance Random Word64 where
547 randomR = integralRandomR
548 random = randomR (minBound,maxBound)
549-}