git.iko.soy/text
on master help sign in
Add more near-boundary-condition tests for bounded ints
18dd483Bryan O'Sullivan
tests/Tests/Properties.hs+42−1
compare with master
unifiedsplit
@@ -753,6 +753,41 @@ tb_decimal_word16 (a::Word16) = tb_decimal a
753tb_decimal_word32 (a::Word32) = tb_decimal a
753tb_decimal_word32 (a::Word32) = tb_decimal a
754tb_decimal_word64 (a::Word64) = tb_decimal a
754tb_decimal_word64 (a::Word64) = tb_decimal a
755
755
756+tb_decimal_big_int (BigBounded (a::Int)) = tb_decimal a
757+tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a
758+tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a
759+tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a
760+
761+countDigits :: (Integral a) => a -> Int
762+countDigits v0
763+ | v0 > max64 = big 20 (v0 `quot` 10000000000000000000)
764+ | otherwise = go 1 (fromIntegral v0 :: Word64)
765+ where
766+ max64 = fromIntegral (maxBound :: Word64)
767+ big !k v
768+ | v > max64 = big (k+20) (v `quot` 10000000000000000000)
769+ | otherwise = go k (fromIntegral v :: Word64)
770+ go !k v
771+ | v < 10 = k
772+ | v < 100 = k + 1
773+ | v < 1000 = k + 2
774+ | v < 1000000000000 =
775+ k + if v < 100000000
776+ then if v < 1000000
777+ then if v < 10000
778+ then 3
779+ else 4 + fin v 100000
780+ else 6 + fin v 10000000
781+ else if v < 10000000000
782+ then 8 + fin v 1000000000
783+ else 10 + fin v 100000000000
784+ | otherwise = go (k + 12) (v `quot` 1000000000000)
785+ fin v n = if v >= n then 1 else 0
786+
787+t_cd (Big k) = counterexample (show x ++ " /= " ++ show y) (x == y)
788+ where x = countDigits k
789+ y = length (show k)
790+
756tb_hex :: (Integral a, Show a) => a -> Bool
791tb_hex :: (Integral a, Show a) => a -> Bool
757tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
792tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
758
793
@@ -854,6 +889,8 @@ shorten n t@(S.Stream arr off len)
854tests :: Test
889tests :: Test
855tests =
890tests =
856 testGroup "Properties" [
891 testGroup "Properties" [
892+ testProperty "t_cd" t_cd,
893+
857 testGroup "creation/elimination" [
894 testGroup "creation/elimination" [
858 testProperty "t_pack_unpack" t_pack_unpack,
895 testProperty "t_pack_unpack" t_pack_unpack,
859 testProperty "tl_pack_unpack" tl_pack_unpack,
896 testProperty "tl_pack_unpack" tl_pack_unpack,
@@ -1258,7 +1295,11 @@ tests =
1258 testProperty "tb_decimal_word8" tb_decimal_word8,
1295 testProperty "tb_decimal_word8" tb_decimal_word8,
1259 testProperty "tb_decimal_word16" tb_decimal_word16,
1296 testProperty "tb_decimal_word16" tb_decimal_word16,
1260 testProperty "tb_decimal_word32" tb_decimal_word32,
1297 testProperty "tb_decimal_word32" tb_decimal_word32,
1261− testProperty "tb_decimal_word64" tb_decimal_word64
1298+ testProperty "tb_decimal_word64" tb_decimal_word64,
1299+ testProperty "tb_decimal_big_int" tb_decimal_big_int,
1300+ testProperty "tb_decimal_big_word" tb_decimal_big_word,
1301+ testProperty "tb_decimal_big_int64" tb_decimal_big_int64,
1302+ testProperty "tb_decimal_big_word64" tb_decimal_big_word64
1262 ],
1303 ],
1263 testGroup "hexadecimal" [
1304 testGroup "hexadecimal" [
1264 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
1305 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
tests/Tests/QuickCheckUtils.hs+8−1
@@ -18,6 +18,7 @@ module Tests.QuickCheckUtils
18 , unsquare
18 , unsquare
19 , smallArbitrary
19 , smallArbitrary
20
20
21+ , BigBounded(..)
21 , BigInt(..)
22 , BigInt(..)
22 , NotEmpty (..)
23 , NotEmpty (..)
23
24
@@ -166,10 +167,16 @@ newtype BigInt = Big Integer
166 deriving (Eq, Show)
167 deriving (Eq, Show)
167
168
168instance Arbitrary BigInt where
169instance Arbitrary BigInt where
169− arbitrary = choose (20::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e)
170+ arbitrary = choose (1::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e)
170 shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l]
171 shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l]
171 where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer
172 where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer
172
173
174+newtype BigBounded a = BigBounded a
175+ deriving (Eq, Show)
176+
177+instance (Bounded a, Random a, Arbitrary a) => Arbitrary (BigBounded a) where
178+ arbitrary = BigBounded <$> choose (minBound, maxBound)
179+
173newtype NotEmpty a = NotEmpty { notEmpty :: a }
180newtype NotEmpty a = NotEmpty { notEmpty :: a }
174 deriving (Eq, Ord)
181 deriving (Eq, Ord)
175
182