@@ -117,6 +117,10 @@ tests =
117117 , testProperty "Word32" (prop_bitget_bytestring_interspersed :: W Word32 -> [B.ByteString] -> Property)
118118 , testProperty "Word64" (prop_bitget_bytestring_interspersed :: W Word64 -> [B.ByteString] -> Property)
119119 ]
120+ , testGroup "Simulate programs"
121+ [ testProperty "primitive" prop_primitive
122+ , testProperty "many primitives in sequence" prop_program
123+ ]
120124 ]
121125
122126prop_isEmptyOfEmptyEmpty :: Bool
@@ -375,6 +379,82 @@ integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
375379 fromIntegral b :: Integer) g of
376380 (x,g) -> (fromIntegral x, g)
377381
382+data Primitive
383+ = W8 Int Word8
384+ | W16 Int Word16
385+ | W32 Int Word32
386+ | W64 Int Word64
387+ | BS Int B.ByteString
388+ | LBS Int L.ByteString
389+ deriving (Eq, Show)
390+
391+type Program = [Primitive]
392+
393+instance Arbitrary Primitive where
394+ arbitrary = do
395+ let gen c = do
396+ let (maxBits, _) = (\w -> (bitSize w, c undefined w)) undefined
397+ bits <- choose (0, maxBits)
398+ n <- choose (0, fromIntegral (2^bits-1))
399+ return (c bits n)
400+ oneof
401+ [ gen W8
402+ , gen W16
403+ , gen W32
404+ , gen W64
405+ , do n <- choose (0,10)
406+ cs <- vector n
407+ return (BS n (B.pack cs))
408+ , do n <- choose (0,10)
409+ cs <- vector n
410+ return (LBS n (L.pack cs))
411+ ]
412+ shrink p =
413+ let snk c x = map (\x' -> c (bitreq x') x') (shrinker x) in
414+ case p of
415+ W8 _ x -> snk W8 x
416+ W16 _ x -> snk W16 x
417+ W32 _ x -> snk W32 x
418+ W64 _ x -> snk W64 x
419+ BS _ bs -> let ws = B.unpack bs in map (\ws' -> BS (length ws') (B.pack ws')) (shrink ws)
420+ LBS _ lbs -> let ws = L.unpack lbs in map (\ws' -> LBS (length ws') (L.pack ws')) (shrink ws)
421+
422+prop_primitive :: Primitive -> Property
423+prop_primitive prim = property $
424+ let p = putPrimitive prim
425+ g = getPrimitive prim
426+ lbs = runPut (runBitPut p)
427+ r = runGet (runBitGet g) lbs
428+ in r == prim
429+
430+prop_program :: Program -> Property
431+prop_program program = property $
432+ let p = mapM_ putPrimitive program
433+ g = mapM getPrimitive program
434+ lbs = runPut (runBitPut p)
435+ r = runGet (runBitGet g) lbs
436+ in r == program
437+
438+putPrimitive :: Primitive -> BitPut ()
439+putPrimitive p =
440+ case p of
441+ W8 n x -> putWord8 n x
442+ W16 n x -> putWord16be n x
443+ W32 n x -> putWord32be n x
444+ W64 n x -> putWord64be n x
445+ BS _ bs -> putByteString bs
446+ LBS _ lbs -> mapM_ putByteString (L.toChunks lbs)
447+
448+getPrimitive :: Primitive -> BitGet Primitive
449+getPrimitive p =
450+ case p of
451+ W8 n _ -> W8 n <$> getWord8 n
452+ W16 n _ -> W16 n <$> getWord16be n
453+ W32 n _ -> W32 n <$> getWord32be n
454+ W64 n _ -> W64 n <$> getWord64be n
455+ BS n _ -> BS n <$> getByteString n
456+ LBS n _ -> LBS n <$> getLazyByteString n
457+
378458{-
379459instance Random Word where
380460 randomR = integralRandomR