@@ -4,8 +4,11 @@ import Data.Binary ( encode )
4import Data.Binary.Get ( runGet )
4import Data.Binary.Get ( runGet )
5import Data.Binary.Put ( runPut )
5import Data.Binary.Put ( runPut )
7import Data.Bits
9import Data.Bits
8import Data.Word
10import Data.Word
11+import Foreign.Storable
9import System.Random
12import System.Random
11import BitsGet
14import BitsGet
@@ -16,61 +19,45 @@ import Test.QuickCheck
17 quickCheck prop_Bools
20 quickCheck prop_Bools
18 quickCheck prop_SimpleCase
21 quickCheck prop_SimpleCase
19− quickCheck prop_Word8_putget
22+
20− quickCheck prop_Word8_putget_list
23+ quickCheck (prop_putget_with_bitreq :: Word8 -> Property)
21− quickCheck prop_Word16be_putget
24+ quickCheck (prop_putget_with_bitreq :: Word16 -> Property)
22− quickCheck prop_Word16be_putget_list_simple
25+
23− quickCheck prop_Word16be_putget_list
26+ quickCheck (prop_putget_list_simple :: [Bool] -> Property)
27+ quickCheck (prop_putget_list_simple :: [Word8] -> Property)
28+ quickCheck (prop_putget_list_simple :: [Word16] -> Property)
30+ quickCheck (prop_putget_list_with_bitreq :: [Word8] -> Property)
31+ quickCheck (prop_putget_list_with_bitreq :: [Word16] -> Property)
25 -- these tests use the R structure
33 -- these tests use the R structure
27 -- quickCheck prop_Word32_from_2_Word16
35 -- quickCheck prop_Word32_from_2_Word16
28 -- quickCheck prop_Word32_from_Word8_and_Word16
36 -- quickCheck prop_Word32_from_Word8_and_Word16
30−prop_Word8_putget :: Word8 -> Property
38+prop_putget_with_bitreq :: (BinaryBit a, Num a, Bits a, Ord a) => a -> Property
31−prop_Word8_putget w = property $
39+prop_putget_with_bitreq 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
39−prop_Word16be_putget :: Word16 -> Property
40−prop_Word16be_putget w = property $
41 -- write all words with as many bits as it's required
40 -- write all words with as many bits as it's required
42− let p = putWord16be (bitreq w) w
41+ let p = putBits (bitreq w) w
43− g = getWord16be (bitreq w)
42+ g = getBits (bitreq w)
44 lbs = runPut (runBitPut p)
43 lbs = runPut (runBitPut p)
45 w' = runGet (runBitGetSimple g) lbs
44 w' = runGet (runBitGetSimple g) lbs
46 in w == w'
45 in w == w'
48−prop_Word8_putget_list :: [Word8] -> Property
47+prop_putget_list_simple :: (BinaryBit a, Eq a, Storable a) => [a] -> Property
49−prop_Word8_putget_list ws = property $
48+prop_putget_list_simple ws = property $
50− -- write all word8s with as many bits as it's required
49+ let s = sizeOf (head ws) * 8
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
57− bitlist = map bitreq ws
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
50+ p = mapM_ (\v -> putBits s v) ws
62− g = mapM (const (getWord16be 16)) ws
51+ g = mapM (const (getBits s)) ws
63 lbs = runPut (runBitPut p)
52 lbs = runPut (runBitPut p)
64 ws' = runGet (runBitGetSimple g) lbs
53 ws' = runGet (runBitGetSimple g) lbs
65 in ws == ws'
54 in ws == ws'
67− bitlist = map bitreq ws
69−prop_Word16be_putget_list :: [Word16] -> Property
56+prop_putget_list_with_bitreq :: (BinaryBit a, Num a, Bits a, Ord a) => [a] -> Property
70−prop_Word16be_putget_list ws = property $
57+prop_putget_list_with_bitreq ws = property $
71 -- write all words with as many bits as it's required
58 -- write all words with as many bits as it's required
72− let p = mapM_ (\v -> putWord16be (bitreq v) v) ws
59+ let p = mapM_ (\v -> putBits (bitreq v) v) ws
73− g = mapM getWord16be bitlist
60+ g = mapM getBits bitlist
74 lbs = runPut (runBitPut p)
61 lbs = runPut (runBitPut p)
75 ws' = runGet (runBitGetSimple g) lbs
62 ws' = runGet (runBitGetSimple g) lbs
76 in ws == ws'
63 in ws == ws'