@@ -380,7 +380,8 @@ integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
380 (x,g) -> (fromIntegral x, g)
380 (x,g) -> (fromIntegral x, g)
382data Primitive
382data Primitive
383− = W8 Int Word8
384+ | W8 Int Word8
384 | W16 Int Word16
385 | W16 Int Word16
385 | W32 Int Word32
386 | W32 Int Word32
386 | W64 Int Word64
387 | W64 Int Word64
@@ -399,7 +400,8 @@ instance Arbitrary Primitive where
399 n <- choose (0, fromIntegral (2^bits-1))
400 n <- choose (0, fromIntegral (2^bits-1))
400 return (c bits n)
401 return (c bits n)
403+ [ Bool <$> arbitrary
402− [ gen W8
404+ , gen W8
403 , gen W16
405 , gen W16
404 , gen W32
406 , gen W32
405 , gen W64
407 , gen W64
@@ -414,6 +416,7 @@ instance Arbitrary Primitive where
414 shrink p =
416 shrink p =
415 let snk c x = map (\x' -> c (bitreq x') x') (shrinker x) in
417 let snk c x = map (\x' -> c (bitreq x') x') (shrinker x) in
416 case p of
418 case p of
419+ Bool b -> if b then [Bool False] else []
417 W8 _ x -> snk W8 x
420 W8 _ x -> snk W8 x
418 W16 _ x -> snk W16 x
421 W16 _ x -> snk W16 x
419 W32 _ x -> snk W32 x
422 W32 _ x -> snk W32 x
@@ -441,6 +444,7 @@ prop_program program = property $
441putPrimitive :: Primitive -> BitPut ()
444putPrimitive :: Primitive -> BitPut ()
442putPrimitive p =
445putPrimitive p =
443 case p of
446 case p of
444 W8 n x -> putWord8 n x
448 W8 n x -> putWord8 n x
445 W16 n x -> putWord16be n x
449 W16 n x -> putWord16be n x
446 W32 n x -> putWord32be n x
450 W32 n x -> putWord32be n x
@@ -452,6 +456,7 @@ putPrimitive p =
452getPrimitive :: Primitive -> BitGet Primitive
456getPrimitive :: Primitive -> BitGet Primitive
453getPrimitive p =
457getPrimitive p =
454 case p of
458 case p of
459+ Bool _ -> Bool <$> getBool
455 W8 n _ -> W8 n <$> getWord8 n
460 W8 n _ -> W8 n <$> getWord8 n
456 W16 n _ -> W16 n <$> getWord16be n
461 W16 n _ -> W16 n <$> getWord16be n
457 W32 n _ -> W32 n <$> getWord32be n
462 W32 n _ -> W32 n <$> getWord32be n
@@ -467,6 +472,7 @@ verifyProgram totalLength ps0 = go 0 ps0
467 go _ [] = return True
472 go _ [] = return True
468 go pos (p:ps) =
473 go pos (p:ps) =
469 case p of
474 case p of
475+ Bool x -> check x getBool >> go (pos+1) ps
470 W8 n x -> check x (getWord8 n) >> go (pos+n) ps
476 W8 n x -> check x (getWord8 n) >> go (pos+n) ps
471 W16 n x -> check x (getWord16be n) >> go (pos+n) ps
477 W16 n x -> check x (getWord16be n) >> go (pos+n) ps
472 W32 n x -> check x (getWord32be n) >> go (pos+n) ps
478 W32 n x -> check x (getWord32be n) >> go (pos+n) ps
@@ -478,12 +484,14 @@ verifyProgram totalLength ps0 = go 0 ps0
478 actual <- isEmpty
484 actual <- isEmpty
479 if expected == actual
485 if expected == actual
480 then go pos ps
486 then go pos ps
481− else error "isEmpty returned wrong value"
487+ else error $ "isEmpty returned wrong value, expected "
488+ ++ show expected ++ " but got " ++ show actual
482 check x g = do
489 check x g = do
484 if x == y
491 if x == y
485 then return ()
492 then return ()
486− else error "fail fail fail!"
493+ else error $ "Roundtrip error: Expected "
494+ ++ show x ++ " but got " ++ show y
489instance Random Word where
497instance Random Word where