diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs index e88cc473f22c49b6d1b03128edf8f24386c5f91f..3100731f1cb2c725fee13b572803b06649ad2b88 100644 --- a/tests/Tests/Properties.hs +++ b/tests/Tests/Properties.hs @@ -741,8 +741,7 @@ tb_decimal :: (Integral a, Show a) => a -> Bool tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show) tb_decimal_integer (a::Integer) = tb_decimal a -tb_decimal_integer_big = forAll big tb_decimal - where big = choose (20::Int,200) >>= \e -> choose (10^(e-1),10^e::Integer) +tb_decimal_integer_big (Big a) = tb_decimal a tb_decimal_int (a::Int) = tb_decimal a tb_decimal_int8 (a::Int8) = tb_decimal a tb_decimal_int16 (a::Int16) = tb_decimal a diff --git a/tests/Tests/QuickCheckUtils.hs b/tests/Tests/QuickCheckUtils.hs index 242af447c71d7c51d0d3c0744f706a4a69f4a47a..f7c4374b3f3bd2593ff12472c456322604023288 100644 --- a/tests/Tests/QuickCheckUtils.hs +++ b/tests/Tests/QuickCheckUtils.hs @@ -18,6 +18,7 @@ module Tests.QuickCheckUtils , unsquare , smallArbitrary + , BigInt(..) , NotEmpty (..) , Small (..) @@ -37,6 +38,7 @@ module Tests.QuickCheckUtils , write_read ) where +import Control.Applicative ((<$>)) import Control.Arrow (first, (***)) import Control.DeepSeq (NFData (..), deepseq) import Control.Exception (bracket) @@ -160,6 +162,14 @@ instance Arbitrary TL.Text where arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary shrink = map TL.pack . shrink . TL.unpack +newtype BigInt = Big Integer + deriving (Eq, Show) + +instance Arbitrary BigInt where + arbitrary = choose (20::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 NotEmpty a = NotEmpty { notEmpty :: a } deriving (Eq, Ord)