on master help sign in
Cleanup in tests
commit4b75399ed5b51649babc6ef6450769a5c42f0bf5 authorLennart Kolmodin <kolmodin@gentoo.org> dateThu 26 Aug 2010, 17:24 (16 years ago) parent6a0ad9d
1 file changed+4−34
BitsQC.hs+4−34
BitsQC.hs+4−34
@@ -24,14 +24,12 @@ main = do
2424
2525 -- these tests use the R structure
2626 --
27− -- quickCheck prop_Word16be_with_offset
28− -- quickCheck prop_Word16be_list
2927 -- quickCheck prop_Word32_from_2_Word16
3028 -- quickCheck prop_Word32_from_Word8_and_Word16
3129
3230prop_Word8_putget :: Word8 -> Property
3331prop_Word8_putget w = property $
34− -- write all word8s with as many bits as it's required
32+ -- write all words with as many bits as it's required
3533 let p = putWord8 (bitreq w) w
3634 g = getWord8 (bitreq w)
3735 lbs = runPut (runBitPut p)
@@ -40,7 +38,7 @@ prop_Word8_putget w = property $
4038
4139prop_Word16be_putget :: Word16 -> Property
4240prop_Word16be_putget w = property $
43− -- write all word8s with as many bits as it's required
41+ -- write all words with as many bits as it's required
4442 let p = putWord16be (bitreq w) w
4543 g = getWord16be (bitreq w)
4644 lbs = runPut (runBitPut p)
@@ -60,7 +58,6 @@ prop_Word8_putget_list ws = property $
6058
6159prop_Word16be_putget_list_simple :: [Word16] -> Property
6260prop_Word16be_putget_list_simple ws = property $
63− -- write all word8s with as many bits as it's required
6461 let p = mapM_ (\v -> putWord16be 16 v) ws
6562 g = mapM (const (getWord16be 16)) ws
6663 lbs = runPut (runBitPut p)
@@ -71,7 +68,7 @@ prop_Word16be_putget_list_simple ws = property $
7168
7269prop_Word16be_putget_list :: [Word16] -> Property
7370prop_Word16be_putget_list ws = property $
74− -- write all word8s with as many bits as it's required
71+ -- write all words with as many bits as it's required
7572 let p = mapM_ (\v -> putWord16be (bitreq v) v) ws
7673 g = mapM getWord16be bitlist
7774 lbs = runPut (runBitPut p)
@@ -85,7 +82,7 @@ bitreq :: (Num b, Bits a, Ord a) => a -> b
8582bitreq v = fromIntegral . head $ [ req | (req, top) <- bittable, v <= top ]
8683
8784bittable :: Bits a => [(Integer, a)]
88−bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..16] ]
85+bittable = [ (fromIntegral x, (1 `shiftL` x) - 1) | x <- [1..64] ]
8986
9087prop_Bools :: [Bool] -> Property
9188prop_Bools bs = property $
@@ -112,33 +109,6 @@ prop_SimpleCase b w = w < 0x8000 ==>
112109
113110
114111{-
115−prop_SimpleCase :: Word16 -> Property
116−prop_SimpleCase w = w < 0x8000 ==>
117− let p = RMap RBool $ \v -> case v of
118− True -> RWord16be 15
119− False -> RMapPure
120− (RWord8 7 `RNextTo` RWord8 8)
121− (\(msb:*:lsb)-> (fromIntegral msb `shiftL` 8) .|. fromIntegral lsb)
122− w' = runGet (get p) lbs
123− in w == w'
124− where
125− lbs = runPut (putWord16be w)
126−
127−prop_Word16be_with_offset :: Word16 -> Property
128−prop_Word16be_with_offset w = w < 0x8000 ==>
129− let b :*: w' :*: w'' = runGet (get (RCheck RBool not "fail" `RNextTo` RWord16be 15 `RNextTo` RWord16be 16)) lbs
130− in w == w' && w == w''
131− where
132− lbs = runPut (putWord16be w >> putWord16be w)
133−
134−prop_Word16be_list :: Word8 -> [Word16] -> Property
135−prop_Word16be_list w ws = property $
136− let p = RWord8 8 `RNextTo` RList (length ws) (RWord16be 16) :: R (T Word8 [Word16])
137− w' :*: ws' = runGet (get p) lbs :: T Word8 [Word16]
138− in ws == ws' && w == w'
139− where
140− lbs = runPut (putWord8 w >> mapM_ putWord16be ws)
141−
142112prop_Word32_from_Word8_and_Word16 :: Word8 -> Word16 -> Property
143113prop_Word32_from_Word8_and_Word16 w8 w16 = property $
144114 let p = RWord32be 24