2b13ada · text · git.iko.soy

git.iko.soy/text

A better test for gh-99

commit2b13adaf2b0f4bc425a20c7b9e0a25db36b113f2 authorBryan O'Sullivan <bos@serpentine.com> dateFri 31 Oct 2014, 16:46 (12 years ago) parent240ce66

2 files changed+11−2

compare with master

unifiedsplit

tests/Tests/Properties.hs+1−2 tests/Tests/QuickCheckUtils.hs+10

tests/Tests/Properties.hs+1−2

@@ -741,8 +741,7 @@ tb_decimal :: (Integral a, Show a) => a -> Bool

741741tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)

742742

743743tb_decimal_integer (a::Integer) = tb_decimal a

744−tb_decimal_integer_big = forAll big tb_decimal

745− where big = choose (20::Int,200) >>= \e -> choose (10^(e-1),10^e::Integer)

744+tb_decimal_integer_big (Big a) = tb_decimal a

746745tb_decimal_int (a::Int) = tb_decimal a

747746tb_decimal_int8 (a::Int8) = tb_decimal a

748747tb_decimal_int16 (a::Int16) = tb_decimal a

tests/Tests/QuickCheckUtils.hs+10

@@ -18,6 +18,7 @@ module Tests.QuickCheckUtils

1818 , unsquare

1919 , smallArbitrary

2020

21+ , BigInt(..)

2122 , NotEmpty (..)

2223

2324 , Small (..)

@@ -37,6 +38,7 @@ module Tests.QuickCheckUtils

3738 , write_read

3839 ) where

3940

41+import Control.Applicative ((<$>))

4042import Control.Arrow (first, (***))

4143import Control.DeepSeq (NFData (..), deepseq)

4244import Control.Exception (bracket)

@@ -160,6 +162,14 @@ instance Arbitrary TL.Text where

160162 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary

161163 shrink = map TL.pack . shrink . TL.unpack

162164

165+newtype BigInt = Big Integer

166+ deriving (Eq, Show)

167+

168+instance Arbitrary BigInt where

169+ arbitrary = choose (20::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e)

170+ shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l]

171+ where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer

172+

163173newtype NotEmpty a = NotEmpty { notEmpty :: a }

164174 deriving (Eq, Ord)

165175