diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs index 3100731f1cb2c725fee13b572803b06649ad2b88..7d4a3e6da443d7ef73cca0987ddba16548a366d5 100644 --- a/tests/Tests/Properties.hs +++ b/tests/Tests/Properties.hs @@ -753,6 +753,41 @@ tb_decimal_word16 (a::Word16) = tb_decimal a tb_decimal_word32 (a::Word32) = tb_decimal a tb_decimal_word64 (a::Word64) = tb_decimal a +tb_decimal_big_int (BigBounded (a::Int)) = tb_decimal a +tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a +tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a +tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a + +countDigits :: (Integral a) => a -> Int +countDigits v0 + | v0 > max64 = big 20 (v0 `quot` 10000000000000000000) + | otherwise = go 1 (fromIntegral v0 :: Word64) + where + max64 = fromIntegral (maxBound :: Word64) + big !k v + | v > max64 = big (k+20) (v `quot` 10000000000000000000) + | otherwise = go k (fromIntegral v :: Word64) + go !k v + | v < 10 = k + | v < 100 = k + 1 + | v < 1000 = k + 2 + | v < 1000000000000 = + k + if v < 100000000 + then if v < 1000000 + then if v < 10000 + then 3 + else 4 + fin v 100000 + else 6 + fin v 10000000 + else if v < 10000000000 + then 8 + fin v 1000000000 + else 10 + fin v 100000000000 + | otherwise = go (k + 12) (v `quot` 1000000000000) + fin v n = if v >= n then 1 else 0 + +t_cd (Big k) = counterexample (show x ++ " /= " ++ show y) (x == y) + where x = countDigits k + y = length (show k) + tb_hex :: (Integral a, Show a) => a -> Bool tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "") @@ -854,6 +889,8 @@ shorten n t@(S.Stream arr off len) tests :: Test tests = testGroup "Properties" [ + testProperty "t_cd" t_cd, + testGroup "creation/elimination" [ testProperty "t_pack_unpack" t_pack_unpack, testProperty "tl_pack_unpack" tl_pack_unpack, @@ -1258,7 +1295,11 @@ tests = testProperty "tb_decimal_word8" tb_decimal_word8, testProperty "tb_decimal_word16" tb_decimal_word16, testProperty "tb_decimal_word32" tb_decimal_word32, - testProperty "tb_decimal_word64" tb_decimal_word64 + testProperty "tb_decimal_word64" tb_decimal_word64, + testProperty "tb_decimal_big_int" tb_decimal_big_int, + testProperty "tb_decimal_big_word" tb_decimal_big_word, + testProperty "tb_decimal_big_int64" tb_decimal_big_int64, + testProperty "tb_decimal_big_word64" tb_decimal_big_word64 ], testGroup "hexadecimal" [ testProperty "tb_hexadecimal_int" tb_hexadecimal_int, diff --git a/tests/Tests/QuickCheckUtils.hs b/tests/Tests/QuickCheckUtils.hs index f7c4374b3f3bd2593ff12472c456322604023288..6aa45e07282003b17197a699558cfcbcb75fcc0c 100644 --- a/tests/Tests/QuickCheckUtils.hs +++ b/tests/Tests/QuickCheckUtils.hs @@ -18,6 +18,7 @@ module Tests.QuickCheckUtils , unsquare , smallArbitrary + , BigBounded(..) , BigInt(..) , NotEmpty (..) @@ -166,10 +167,16 @@ newtype BigInt = Big Integer deriving (Eq, Show) instance Arbitrary BigInt where - arbitrary = choose (20::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e) + arbitrary = choose (1::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e) shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l] where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer +newtype BigBounded a = BigBounded a + deriving (Eq, Show) + +instance (Bounded a, Random a, Arbitrary a) => Arbitrary (BigBounded a) where + arbitrary = BigBounded <$> choose (minBound, maxBound) + newtype NotEmpty a = NotEmpty { notEmpty :: a } deriving (Eq, Ord)