on master help sign in
tests: Also test Bools in program simulation
commitac8e0cab6f98947d89fdf091ef796123e1b42031 authorLennart Kolmodin <kolmodin@gmail.com> dateSat 6 Apr 2013, 14:10 (14 years ago) parent0d2d17e
1 file changed+12−4
BitsQC.hs+12−4
BitsQC.hs+12−4
@@ -380,7 +380,8 @@ integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
380380 (x,g) -> (fromIntegral x, g)
381381
382382data Primitive
383− = W8 Int Word8
383+ = Bool Bool
384+ | W8 Int Word8
384385 | W16 Int Word16
385386 | W32 Int Word32
386387 | W64 Int Word64
@@ -399,7 +400,8 @@ instance Arbitrary Primitive where
399400 n <- choose (0, fromIntegral (2^bits-1))
400401 return (c bits n)
401402 oneof
402− [ gen W8
403+ [ Bool <$> arbitrary
404+ , gen W8
403405 , gen W16
404406 , gen W32
405407 , gen W64
@@ -414,6 +416,7 @@ instance Arbitrary Primitive where
414416 shrink p =
415417 let snk c x = map (\x' -> c (bitreq x') x') (shrinker x) in
416418 case p of
419+ Bool b -> if b then [Bool False] else []
417420 W8 _ x -> snk W8 x
418421 W16 _ x -> snk W16 x
419422 W32 _ x -> snk W32 x
@@ -441,6 +444,7 @@ prop_program program = property $
441444putPrimitive :: Primitive -> BitPut ()
442445putPrimitive p =
443446 case p of
447+ Bool b -> putBool b
444448 W8 n x -> putWord8 n x
445449 W16 n x -> putWord16be n x
446450 W32 n x -> putWord32be n x
@@ -452,6 +456,7 @@ putPrimitive p =
452456getPrimitive :: Primitive -> BitGet Primitive
453457getPrimitive p =
454458 case p of
459+ Bool _ -> Bool <$> getBool
455460 W8 n _ -> W8 n <$> getWord8 n
456461 W16 n _ -> W16 n <$> getWord16be n
457462 W32 n _ -> W32 n <$> getWord32be n
@@ -467,6 +472,7 @@ verifyProgram totalLength ps0 = go 0 ps0
467472 go _ [] = return True
468473 go pos (p:ps) =
469474 case p of
475+ Bool x -> check x getBool >> go (pos+1) ps
470476 W8 n x -> check x (getWord8 n) >> go (pos+n) ps
471477 W16 n x -> check x (getWord16be n) >> go (pos+n) ps
472478 W32 n x -> check x (getWord32be n) >> go (pos+n) ps
@@ -478,12 +484,14 @@ verifyProgram totalLength ps0 = go 0 ps0
478484 actual <- isEmpty
479485 if expected == actual
480486 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
482489 check x g = do
483490 y <- g
484491 if x == y
485492 then return ()
486− else error "fail fail fail!"
493+ else error $ "Roundtrip error: Expected "
494+ ++ show x ++ " but got " ++ show y
487495
488496{-
489497instance Random Word where