@@ -4,8 +4,11 @@ import Data.Binary ( encode )
44import Data.Binary.Get ( runGet )
55import Data.Binary.Put ( runPut )
66
7+import Bits
8+
79import Data.Bits
810import Data.Word
11+import Foreign.Storable
912import System.Random
1013
1114import BitsGet
@@ -16,61 +19,45 @@ import Test.QuickCheck
1619main = do
1720 quickCheck prop_Bools
1821 quickCheck prop_SimpleCase
19− quickCheck prop_Word8_putget
20− quickCheck prop_Word8_putget_list
21− quickCheck prop_Word16be_putget
22− quickCheck prop_Word16be_putget_list_simple
23− quickCheck prop_Word16be_putget_list
22+
23+ quickCheck (prop_putget_with_bitreq :: Word8 -> Property)
24+ quickCheck (prop_putget_with_bitreq :: Word16 -> Property)
25+
26+ quickCheck (prop_putget_list_simple :: [Bool] -> Property)
27+ quickCheck (prop_putget_list_simple :: [Word8] -> Property)
28+ quickCheck (prop_putget_list_simple :: [Word16] -> Property)
29+
30+ quickCheck (prop_putget_list_with_bitreq :: [Word8] -> Property)
31+ quickCheck (prop_putget_list_with_bitreq :: [Word16] -> Property)
2432
2533 -- these tests use the R structure
2634 --
2735 -- quickCheck prop_Word32_from_2_Word16
2836 -- quickCheck prop_Word32_from_Word8_and_Word16
2937
30−prop_Word8_putget :: Word8 -> Property
31−prop_Word8_putget w = property $
32− -- write all words with as many bits as it's required
33− let p = putWord8 (bitreq w) w
34− g = getWord8 (bitreq w)
35− lbs = runPut (runBitPut p)
36− w' = runGet (runBitGetSimple g) lbs
37− in w == w'
38−
39−prop_Word16be_putget :: Word16 -> Property
40−prop_Word16be_putget w = property $
38+prop_putget_with_bitreq :: (BinaryBit a, Num a, Bits a, Ord a) => a -> Property
39+prop_putget_with_bitreq w = property $
4140 -- write all words with as many bits as it's required
42− let p = putWord16be (bitreq w) w
43− g = getWord16be (bitreq w)
41+ let p = putBits (bitreq w) w
42+ g = getBits (bitreq w)
4443 lbs = runPut (runBitPut p)
4544 w' = runGet (runBitGetSimple g) lbs
4645 in w == w'
4746
48−prop_Word8_putget_list :: [Word8] -> Property
49−prop_Word8_putget_list ws = property $
50− -- write all word8s with as many bits as it's required
51− let p = mapM_ (\v -> putWord8 (bitreq v) v) ws
52− g = mapM getWord8 bitlist
53− lbs = runPut (runBitPut p)
54− Right ws' = runGet (runBitGet g) lbs
55− in ws == ws'
56− where
57− bitlist = map bitreq ws
58−
59−prop_Word16be_putget_list_simple :: [Word16] -> Property
60−prop_Word16be_putget_list_simple ws = property $
61− let p = mapM_ (\v -> putWord16be 16 v) ws
62− g = mapM (const (getWord16be 16)) ws
47+prop_putget_list_simple :: (BinaryBit a, Eq a, Storable a) => [a] -> Property
48+prop_putget_list_simple ws = property $
49+ let s = sizeOf (head ws) * 8
50+ p = mapM_ (\v -> putBits s v) ws
51+ g = mapM (const (getBits s)) ws
6352 lbs = runPut (runBitPut p)
6453 ws' = runGet (runBitGetSimple g) lbs
6554 in ws == ws'
66− where
67− bitlist = map bitreq ws
6855
69−prop_Word16be_putget_list :: [Word16] -> Property
70−prop_Word16be_putget_list ws = property $
56+prop_putget_list_with_bitreq :: (BinaryBit a, Num a, Bits a, Ord a) => [a] -> Property
57+prop_putget_list_with_bitreq ws = property $
7158 -- write all words with as many bits as it's required
72− let p = mapM_ (\v -> putWord16be (bitreq v) v) ws
73− g = mapM getWord16be bitlist
59+ let p = mapM_ (\v -> putBits (bitreq v) v) ws
60+ g = mapM getBits bitlist
7461 lbs = runPut (runBitPut p)
7562 ws' = runGet (runBitGetSimple g) lbs
7663 in ws == ws'