Unverified Commit e7cb443a authored by Bodigrim's avatar Bodigrim Committed by GitHub
Browse files

Refactor tests (#345)

* Tests: replace unsquare with a shrinkable newtype

* Tests: do not depend on quickcheck-unicode

* Refactor most of remaining forAll

* Refactor t_utf8_err to report more information about counterexamples
parent d7bcf44a
......@@ -42,32 +42,23 @@ sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)
where _types = f :: Char -> Char -> Char
t_foldr f z = L.foldr f z `eqP` T.foldr f z
where _types = f :: Char -> Char -> Char
tl_foldr f z = unsquare $
L.foldr f z `eqP` TL.foldr f z
tl_foldr f z = L.foldr f z `eqPSqrt` TL.foldr f z
where _types = f :: Char -> Char -> Char
sf_foldr1 p f = unsquare $
(L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqPSqrt` (S.foldr1 f . S.filter p)
t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
tl_foldr1 f = unsquare $
L.foldr1 f `eqP` TL.foldr1 f
tl_foldr1 f = L.foldr1 f `eqPSqrt` TL.foldr1 f
-- Special folds
s_concat_s = unsquare $
L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
sf_concat p = unsquare $
(L.concat . map (L.filter p)) `eq`
(unpackS . S.concat . map (S.filter p . packS))
t_concat = unsquare $
L.concat `eq` (unpackS . T.concat . map packS)
tl_concat = unsquare $
L.concat `eq` (unpackS . TL.concat . map TL.pack)
sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
(unpackS . S.concatMap (packS . f) . S.filter p)
t_concatMap f = unsquare $
L.concatMap f `eqP` (unpackS . T.concatMap (packS . f))
tl_concatMap f = unsquare $
L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f))
s_concat_s = (L.concat . unSqrt) `eq` (unpackS . S.unstream . S.concat . map packS . unSqrt)
sf_concat p = (L.concat . map (L.filter p) . unSqrt) `eq`
(unpackS . S.concat . map (S.filter p . packS) . unSqrt)
t_concat = (L.concat . unSqrt) `eq` (unpackS . T.concat . map packS . unSqrt)
tl_concat = (L.concat . unSqrt) `eq` (unpackS . TL.concat . map TL.pack . unSqrt)
sf_concatMap p f = (L.concatMap f . L.filter p) `eqPSqrt`
(unpackS . S.concatMap (packS . f) . S.filter p)
t_concatMap f = L.concatMap f `eqPSqrt` (unpackS . T.concatMap (packS . f))
tl_concatMap f = L.concatMap f `eqPSqrt` (unpackS . TL.concatMap (TL.pack . f))
sf_any q p = (L.any p . L.filter q) `eqP` (S.any p . S.filter q)
t_any p = L.any p `eqP` T.any p
tl_any p = L.any p `eqP` TL.any p
......
......@@ -37,10 +37,8 @@ t_Show = show `eq` (show . T.pack)
tl_Show = show `eq` (show . TL.pack)
t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
t_mconcat = unsquare $
mconcat `eq` (unpackS . mconcat . L.map T.pack)
tl_mconcat = unsquare $
mconcat `eq` (unpackS . mconcat . L.map TL.pack)
t_mconcat = (mconcat . unSqrt) `eq` (unpackS . mconcat . L.map T.pack . unSqrt)
tl_mconcat = (mconcat . unSqrt) `eq` (unpackS . mconcat . L.map TL.pack . unSqrt)
t_mempty = mempty === (unpackS (mempty :: T.Text))
tl_mempty = mempty === (unpackS (mempty :: TL.Text))
t_IsString = fromString `eqP` (T.unpack . fromString)
......
......@@ -9,7 +9,6 @@ import Data.Char (isSpace)
import Test.QuickCheck
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
import Test.QuickCheck.Unicode (char)
import Tests.QuickCheckUtils
import Text.Show.Functions ()
import qualified Data.List as L
......@@ -51,19 +50,27 @@ s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
(unpackS . S.takeWhile p . S.filter q)
noMatch = do
c <- char
d <- suchThat char (/= c)
return (c,d)
data NoMatch = NoMatch Char Char
deriving (Eq, Show)
instance Arbitrary NoMatch where
arbitrary = do
c <- arbitraryUnicodeChar
d <- suchThat arbitraryUnicodeChar (/= c)
return $ NoMatch c d
shrink (NoMatch c d) = fmap (NoMatch c) (filter (/= c) (shrink d))
++ fmap (`NoMatch` d) (filter (/= d) (shrink c))
t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
(unpackS . T.takeWhileEnd p)
t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $
t_takeWhileEnd_null t (NoMatch c d) = T.null $
T.takeWhileEnd (==d) (T.snoc t c)
tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
(unpackS . TL.takeWhileEnd p)
tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $
tl_takeWhileEnd_null t (NoMatch c d) = TL.null $
TL.takeWhileEnd (==d) (TL.snoc t c)
s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
......@@ -117,27 +124,24 @@ tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)
t_inits = L.inits `eqP` (map unpackS . T.inits)
tl_inits = L.inits `eqP` (map unpackS . TL.inits)
t_tails = L.tails `eqP` (map unpackS . T.tails)
tl_tails = unsquare $
L.tails `eqP` (map unpackS . TL.tails)
t_findAppendId = unsquare $ \(NotEmpty s) ts ->
tl_tails = L.tails `eqPSqrt` (map unpackS . TL.tails)
t_findAppendId = \(Sqrt (NotEmpty s)) ts ->
let t = T.intercalate s ts
in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)
tl_findAppendId = unsquare $ \(NotEmpty s) ts ->
tl_findAppendId = \(Sqrt (NotEmpty s)) ts ->
let t = TL.intercalate s ts
in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)
t_findContains = unsquare $ \(NotEmpty s) ->
t_findContains = \(Sqrt (NotEmpty s)) ->
all (T.isPrefixOf s . snd) . T.breakOnAll s . T.intercalate s
tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) .
TL.breakOnAll s . TL.intercalate s
tl_findContains = \(Sqrt (NotEmpty s)) -> all (TL.isPrefixOf s . snd) .
TL.breakOnAll s . TL.intercalate s
sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s
tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s
t_splitOn_split s = unsquare $
(T.splitOn s `eq` Slow.splitOn s) . T.intercalate s
tl_splitOn_split s = unsquare $
((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
(map TL.fromStrict . T.splitOn s)) . T.intercalate s
t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s . unSqrt
tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`
(map TL.fromStrict . T.splitOn s)) . T.intercalate s . unSqrt
t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)
tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)
......@@ -179,14 +183,10 @@ t_lines' = lines' `eqP` (map unpackS . T.lines')
t_words = L.words `eqP` (map unpackS . T.words)
tl_words = L.words `eqP` (map unpackS . TL.words)
t_unlines = unsquare $
L.unlines `eq` (unpackS . T.unlines . map packS)
tl_unlines = unsquare $
L.unlines `eq` (unpackS . TL.unlines . map packS)
t_unwords = unsquare $
L.unwords `eq` (unpackS . T.unwords . map packS)
tl_unwords = unsquare $
L.unwords `eq` (unpackS . TL.unwords . map packS)
t_unlines = (L.unlines . unSqrt) `eq` (unpackS . T.unlines . map packS . unSqrt)
tl_unlines = (L.unlines . unSqrt) `eq` (unpackS . TL.unlines . map packS . unSqrt)
t_unwords = (L.unwords . unSqrt) `eq` (unpackS . T.unwords . map packS . unSqrt)
tl_unwords = (L.unwords . unSqrt) `eq` (unpackS . TL.unwords . map packS . unSqrt)
s_isPrefixOf s = L.isPrefixOf s `eqP`
(S.isPrefixOf (S.stream $ packS s) . S.stream)
......
......@@ -44,29 +44,22 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)
sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
t_map f = map f `eqP` (unpackS . T.map f)
tl_map f = map f `eqP` (unpackS . TL.map f)
s_intercalate c = unsquare $
L.intercalate c `eq`
(unpackS . S.intercalate (packS c) . map packS)
t_intercalate c = unsquare $
L.intercalate c `eq`
(unpackS . T.intercalate (packS c) . map packS)
tl_intercalate c = unsquare $
L.intercalate c `eq`
(unpackS . TL.intercalate (TL.pack c) . map TL.pack)
s_intercalate c = (L.intercalate c . unSqrt) `eq`
(unpackS . S.intercalate (packS c) . map packS . unSqrt)
t_intercalate c = (L.intercalate c . unSqrt) `eq`
(unpackS . T.intercalate (packS c) . map packS . unSqrt)
tl_intercalate c = (L.intercalate c . unSqrt) `eq`
(unpackS . TL.intercalate (TL.pack c) . map TL.pack . unSqrt)
s_intersperse c = L.intersperse c `eqP`
(unpackS . S.intersperse c)
s_intersperse_s c = L.intersperse c `eqP`
(unpackS . S.unstream . S.intersperse c)
sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
(unpackS . S.intersperse c . S.filter p)
t_intersperse c = unsquare $
L.intersperse c `eqP` (unpackS . T.intersperse c)
tl_intersperse c = unsquare $
L.intersperse c `eqP` (unpackS . TL.intersperse c)
t_transpose = unsquare $
L.transpose `eq` (map unpackS . T.transpose . map packS)
tl_transpose = unsquare $
L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
t_intersperse c = L.intersperse c `eqPSqrt` (unpackS . T.intersperse c)
tl_intersperse c = L.intersperse c `eqPSqrt` (unpackS . TL.intersperse c)
t_transpose = (L.transpose . unSqrt) `eq` (map unpackS . T.transpose . map packS . unSqrt)
tl_transpose = (L.transpose . unSqrt) `eq` (map unpackS . TL.transpose . map TL.pack . unSqrt)
t_reverse = L.reverse `eqP` (unpackS . T.reverse)
tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)
t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
......@@ -169,15 +162,16 @@ tl_find p = L.find p `eqP` TL.find p
t_partition p = L.partition p `eqP` (unpack2 . T.partition p)
tl_partition p = L.partition p `eqP` (unpack2 . TL.partition p)
sf_index p s = forAll (choose (-l,l*2))
((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s))
sf_index p s i = ((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s)) j
where l = L.length s
t_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` T.index (packS s))
j = if l == 0 then 0 else i `mod` (3 * l) - l
t_index s i = ((s L.!!) `eq` T.index (packS s)) j
where l = L.length s
j = if l == 0 then 0 else i `mod` (3 * l) - l
tl_index s = forAll (choose (-l,l*2))
((s L.!!) `eq` (TL.index (packS s) . fromIntegral))
tl_index s i = ((s L.!!) `eq` (TL.index (packS s) . fromIntegral)) j
where l = L.length s
j = if l == 0 then 0 else i `mod` (3 * l) - l
t_findIndex p = L.findIndex p `eqP` T.findIndex p
t_count (NotEmpty t) = (subtract 1 . L.length . T.splitOn t) `eq` T.count t
......@@ -194,7 +188,7 @@ t_indices (NotEmpty s) = Slow.indices s `eq` T.indices s
tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
conc = T.concat . TL.toChunks
t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
t_indices_occurs = \(Sqrt (NotEmpty t)) ts ->
let s = T.intercalate t ts
in Slow.indices t s === T.indices t s
......
......@@ -42,22 +42,21 @@ t_latin1 t = E.decodeLatin1 (encodeL1 a) === a
where a = T.map (\c -> chr (ord c `mod` 256)) t
tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a
where a = TL.map (\c -> chr (ord c `mod` 256)) t
t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id
tl_utf8' = forAll genUnicode $ (EL.decodeUtf8' . EL.encodeUtf8) `eq` (id . Right)
t_utf16LE = forAll genUnicode $ (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id
tl_utf16LE = forAll genUnicode $ (EL.decodeUtf16LE . EL.encodeUtf16LE) `eq` id
t_utf16BE = forAll genUnicode $ (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id
tl_utf16BE = forAll genUnicode $ (EL.decodeUtf16BE . EL.encodeUtf16BE) `eq` id
t_utf32LE = forAll genUnicode $ (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id
tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
t_utf8_incr = forAll genUnicode $ \s (Positive n) -> (recode n `eq` id) s
where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 .
E.encodeUtf8
t_utf8 = (E.decodeUtf8 . E.encodeUtf8) `eq` id
t_utf8' = (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
tl_utf8 = (EL.decodeUtf8 . EL.encodeUtf8) `eq` id
tl_utf8' = (EL.decodeUtf8' . EL.encodeUtf8) `eq` (id . Right)
t_utf16LE = (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id
tl_utf16LE = (EL.decodeUtf16LE . EL.encodeUtf16LE) `eq` id
t_utf16BE = (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id
tl_utf16BE = (EL.decodeUtf16BE . EL.encodeUtf16BE) `eq` id
t_utf32LE = (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id
tl_utf32LE = (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
t_utf32BE = (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
tl_utf32BE = (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
t_utf8_incr (Positive n) =
(T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 . E.encodeUtf8) `eq` id
feedChunksOf :: Int -> (B.ByteString -> E.Decoding) -> B.ByteString
-> [(T.Text, B.ByteString)]
......@@ -67,50 +66,61 @@ feedChunksOf n f bs
E.Some t b f' = f x
in (t,b) : feedChunksOf n f' y
t_utf8_undecoded = forAll genUnicode $ \t ->
t_utf8_undecoded t =
let b = E.encodeUtf8 t
ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
leftover = (++ [B.empty]) . init . tail . B.inits
in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls
data Badness = Solo | Leading | Trailing
deriving (Eq, Show)
instance Arbitrary Badness where
arbitrary = elements [Solo, Leading, Trailing]
t_utf8_err :: Badness -> Maybe DecodeErr -> Property
t_utf8_err bad mde = do
let gen = case bad of
Solo -> genInvalidUTF8
Leading -> B.append <$> genInvalidUTF8 <*> genUTF8
Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8
genUTF8 = E.encodeUtf8 <$> genUnicode
forAll gen $ \bs -> MkProperty $
case mde of
-- generate an invalid character
Nothing -> do
c <- choose ('\x10000', maxBound)
let onErr _ _ = Just c
unProperty . monadicIO $ do
l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
in (len `seq` return (Right len)) `Exception.catch`
(\(e::Exception.SomeException) -> return (Left e))
assert $ case l of
Left err ->
"non-BMP replacement characters not supported" `T.isInfixOf` T.pack (show err)
Right _ -> False
-- generate a valid onErr
Just de -> do
onErr <- genDecodeErr de
unProperty . monadicIO $ do
l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
in (len `seq` return (Right len)) `Exception.catch`
(\(e::UnicodeException) -> return (Left e))
assert $ case l of
Left err -> length (show err) >= 0
Right _ -> de /= Strict
data InvalidUtf8 = InvalidUtf8
{ iu8Prefix :: T.Text
, iu8Invalid :: B.ByteString
, iu8Suffix :: T.Text
} deriving (Eq)
instance Show InvalidUtf8 where
show i = "InvalidUtf8 {prefix = " ++ show (iu8Prefix i)
++ ", invalid = " ++ show (iu8Invalid i)
++ ", suffix = " ++ show (iu8Suffix i)
++ ", asBS = " ++ show (toByteString i)
++ ", length = " ++ show (B.length (toByteString i))
++ "}"
toByteString :: InvalidUtf8 -> B.ByteString
toByteString (InvalidUtf8 a b c) =
E.encodeUtf8 a `B.append` b `B.append` E.encodeUtf8 c
instance Arbitrary InvalidUtf8 where
arbitrary = oneof
[ InvalidUtf8 <$> pure mempty <*> genInvalidUTF8 <*> pure mempty
, InvalidUtf8 <$> pure mempty <*> genInvalidUTF8 <*> arbitrary
, InvalidUtf8 <$> arbitrary <*> genInvalidUTF8 <*> pure mempty
, InvalidUtf8 <$> arbitrary <*> genInvalidUTF8 <*> arbitrary
]
shrink (InvalidUtf8 a b c)
= map (\c' -> InvalidUtf8 a b c') (shrink c)
++ map (\a' -> InvalidUtf8 a' b c) (shrink a)
t_utf8_err :: InvalidUtf8 -> Maybe DecodeErr -> Property
-- generate an invalid character
t_utf8_err bad Nothing = forAll (choose ('\x10000', maxBound)) $ \c -> ioProperty $ do
let onErr _ _ = Just c
decoded = E.decodeUtf8With onErr (toByteString bad)
len = T.length decoded
l <- Exception.try (Exception.evaluate len)
pure $ case l of
Left (err :: Exception.SomeException) -> counterexample (show err) $
"non-BMP replacement characters not supported" `T.isInfixOf` T.pack (show err)
Right _ -> counterexample (show (decoded, l)) False
-- generate a valid onErr
t_utf8_err bad (Just de) = forAll (genDecodeErr de) $ \onErr -> ioProperty $ do
let decoded = E.decodeUtf8With onErr (toByteString bad)
len = T.length (E.decodeUtf8With onErr (toByteString bad))
l <- Exception.try (Exception.evaluate len)
pure $ case l of
Left (err :: Exception.SomeException) -> counterexample (show err) $
length (show err) >= 0
Right _ -> counterexample (show (decoded, l)) $ de /= Strict
t_utf8_err' :: B.ByteString -> Property
t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
......
......@@ -5,14 +5,10 @@
{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Tests.QuickCheckUtils
(
genUnicode
, unsquare
, smallArbitrary
, BigBounded(..)
( BigBounded(..)
, BigInt(..)
, NotEmpty(..)
, Sqrt(..)
, Small(..)
, small
......@@ -29,6 +25,7 @@ module Tests.QuickCheckUtils
, unpack2
, eq
, eqP
, eqPSqrt
, Encoding(..)
......@@ -38,7 +35,6 @@ module Tests.QuickCheckUtils
import Control.Arrow (first, (***))
import Control.DeepSeq (NFData (..), deepseq)
import Control.Exception (bracket)
import Data.String (IsString, fromString)
import Data.Text.Foreign (I16)
import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
import Data.Word (Word8, Word16)
......@@ -46,7 +42,6 @@ import Debug.Trace (trace)
import System.Random (Random(..), RandomGen)
import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))
import Test.QuickCheck.Monadic (assert, monadicIO, run)
import Test.QuickCheck.Unicode (string)
import Tests.Utils
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
......@@ -59,9 +54,6 @@ import qualified Data.Text.Internal.Lazy.Fusion as TLF
import qualified Data.Text.Lazy as TL
import qualified System.IO as IO
genUnicode :: IsString a => Gen a
genUnicode = fromString <$> string
genWord8 :: Gen Word8
genWord8 = chooseAny
......@@ -91,21 +83,23 @@ instance Arbitrary BL.ByteString where
]
shrink xs = BL.fromChunks <$> shrink (BL.toChunks xs)
-- For tests that have O(n^2) running times or input sizes, resize
-- | For tests that have O(n^2) running times or input sizes, resize
-- their inputs to the square root of the originals.
unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property
unsquare = forAll smallArbitrary
newtype Sqrt a = Sqrt { unSqrt :: a }
deriving (Eq, Show)
smallArbitrary :: (Arbitrary a, Show a) => Gen a
smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
instance Arbitrary a => Arbitrary (Sqrt a) where
arbitrary = fmap Sqrt $ sized $ \n -> resize (smallish n) arbitrary
where
smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
shrink = map Sqrt . shrink . unSqrt
instance Arbitrary T.Text where
arbitrary = T.pack `fmap` string
arbitrary = (T.pack . getUnicodeString) `fmap` arbitrary
shrink = map T.pack . shrink . T.unpack
instance Arbitrary TL.Text where
arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
arbitrary = (TL.fromChunks . map notEmpty . unSqrt) `fmap` arbitrary
shrink = map TL.pack . shrink . TL.unpack
newtype BigInt = Big Integer
......@@ -268,6 +262,10 @@ eqP f g s w = eql "orig" (f s) (g t) &&
| a =^= b = True
| otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
eqPSqrt :: (Eq a, Show a, Stringy s) =>
(String -> a) -> (s -> a) -> Sqrt String -> Word8 -> Bool
eqPSqrt f g s = eqP f g (unSqrt s)
instance Arbitrary FPFormat where
arbitrary = elements [Exponent, Fixed, Generic]
......
......@@ -212,7 +212,6 @@ test-suite tests
bytestring,
deepseq,
directory,
quickcheck-unicode >= 1.0.1.0,
random,
tasty,
tasty-hunit,
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment