git.iko.soy/text
on master help sign in
Add more near-boundary-condition tests for bounded ints
commit18dd483e9e24adf7bfc3f765e2abff0c9f2a3e17 authorBryan O'Sullivan <bos@serpentine.com> dateMon 3 Nov 2014, 14:44 (12 years ago) parentfe48963
2 files changed+50−2
compare with master
unifiedsplit
tests/Tests/Properties.hs+42−1 tests/Tests/QuickCheckUtils.hs+8−1
tests/Tests/Properties.hs+42−1
@@ -753,6 +753,41 @@ tb_decimal_word16 (a::Word16) = tb_decimal a
753753tb_decimal_word32 (a::Word32) = tb_decimal a
754754tb_decimal_word64 (a::Word64) = tb_decimal a
755755
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+
756791tb_hex :: (Integral a, Show a) => a -> Bool
757792tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
758793
@@ -854,6 +889,8 @@ shorten n t@(S.Stream arr off len)
854889tests :: Test
855890tests =
856891 testGroup "Properties" [
892+ testProperty "t_cd" t_cd,
893+
857894 testGroup "creation/elimination" [
858895 testProperty "t_pack_unpack" t_pack_unpack,
859896 testProperty "tl_pack_unpack" tl_pack_unpack,
@@ -1258,7 +1295,11 @@ tests =
12581295 testProperty "tb_decimal_word8" tb_decimal_word8,
12591296 testProperty "tb_decimal_word16" tb_decimal_word16,
12601297 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
12621303 ],
12631304 testGroup "hexadecimal" [
12641305 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
tests/Tests/QuickCheckUtils.hs+8−1
@@ -18,6 +18,7 @@ module Tests.QuickCheckUtils
1818 , unsquare
1919 , smallArbitrary
2020
21+ , BigBounded(..)
2122 , BigInt(..)
2223 , NotEmpty (..)
2324
@@ -166,10 +167,16 @@ newtype BigInt = Big Integer
166167 deriving (Eq, Show)
167168
168169instance 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)
170171 shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l]
171172 where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer
172173
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+
173180newtype NotEmpty a = NotEmpty { notEmpty :: a }
174181 deriving (Eq, Ord)
175182