summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNickSmallbone <>2018-09-10 12:33:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-09-10 12:33:00 (GMT)
commitfd3313ac4f777784e0cc7c63ba7d169afbf7a31c (patch)
tree7653ac9b3f4e39204becc28fc0285b9cd3d38a4a
parenta6bb76506b03360687be411f51f26149a2f74f0b (diff)
version 2.12.22.12.2
-rw-r--r--QuickCheck.cabal4
-rw-r--r--Test/QuickCheck.hs1
-rw-r--r--Test/QuickCheck/Arbitrary.hs15
-rw-r--r--Test/QuickCheck/Modifiers.hs23
-rw-r--r--changelog8
-rw-r--r--tests/Generators.hs43
6 files changed, 78 insertions, 16 deletions
diff --git a/QuickCheck.cabal b/QuickCheck.cabal
index b652e7c..ee623cf 100644
--- a/QuickCheck.cabal
+++ b/QuickCheck.cabal
@@ -1,5 +1,5 @@
Name: QuickCheck
-Version: 2.12.1
+Version: 2.12.2
Cabal-Version: >= 1.8
Build-type: Simple
License: BSD3
@@ -55,7 +55,7 @@ source-repository head
source-repository this
type: git
location: https://github.com/nick8325/quickcheck
- tag: 2.12.1
+ tag: 2.12.2
flag templateHaskell
Description: Build Test.QuickCheck.All, which uses Template Haskell.
diff --git a/Test/QuickCheck.hs b/Test/QuickCheck.hs
index 41955a2..57d5c5c 100644
--- a/Test/QuickCheck.hs
+++ b/Test/QuickCheck.hs
@@ -216,6 +216,7 @@ module Test.QuickCheck
, OrderedList(..)
, NonEmptyList(..)
, InfiniteList(..)
+ , SortedList(..)
, Positive(..)
, NonZero(..)
, NonNegative(..)
diff --git a/Test/QuickCheck/Arbitrary.hs b/Test/QuickCheck/Arbitrary.hs
index 4239cf7..7fd4e6c 100644
--- a/Test/QuickCheck/Arbitrary.hs
+++ b/Test/QuickCheck/Arbitrary.hs
@@ -1,5 +1,5 @@
-- | Type classes for random generation of values.
---
+--
-- __Note__: the contents of this module are re-exported by
-- "Test.QuickCheck". You do not need to import it directly.
{-# LANGUAGE CPP #-}
@@ -1104,16 +1104,17 @@ shrinkRealFracToPrecision :: RealFrac a
=> a -- ^ "Epsilon" – the minimum deviation we consider
-> a -- ^ Value to shrink
-> [a]
-shrinkRealFracToPrecision ε x
- | x < 0 = 0 : ([id, negate] <*> filter (>0) (shrinkRealFracToPrecision ε $ -x))
- | x < ε = [0]
+shrinkRealFracToPrecision eps x
+ | x < 0 = 0 : ([id, negate] <*> filter (>0) (shrinkRealFracToPrecision eps $ -x))
+ | x < eps = [0 | x /= 0]
| not (x==x) = []
| not (2*x>x) = 0 : takeWhile (<x) ((2^).(^2)<$>[0..])
- | (x-intgPart>ε)
- = intgShrinks ++ [intgPart]
+ | (x-intgPart>eps)
+ = filter (/= x) $
+ intgShrinks ++ [intgPart]
++ map ((intgPart+) . recip)
(filter (>0)
- . shrinkRealFracToPrecision (ε/(x-intgPart))
+ . shrinkRealFracToPrecision (eps/(x-intgPart))
$ 1/(x-intgPart))
| otherwise = intgShrinks
where intgPart = fromInteger $ truncate x
diff --git a/Test/QuickCheck/Modifiers.hs b/Test/QuickCheck/Modifiers.hs
index 90b736f..ec08748 100644
--- a/Test/QuickCheck/Modifiers.hs
+++ b/Test/QuickCheck/Modifiers.hs
@@ -52,6 +52,7 @@ module Test.QuickCheck.Modifiers
, OrderedList(..)
, NonEmptyList(..)
, InfiniteList(..)
+ , SortedList(..)
, Positive(..)
, NonZero(..)
, NonNegative(..)
@@ -196,7 +197,7 @@ data InfiniteList a =
-- the Arbitrary instance generates an infinite list, which is
-- reduced to a finite prefix by shrinking. We use discard to
-- check that nothing coming after the finite prefix is used
--- (see makeInfiniteList).
+-- (see infiniteListFromData).
data InfiniteListInternalData a = Infinite [a] | FinitePrefix [a]
infiniteListFromData :: InfiniteListInternalData a -> InfiniteList a
@@ -226,6 +227,26 @@ instance Arbitrary a => Arbitrary (InfiniteListInternalData a) where
map FinitePrefix (shrink xs)
--------------------------------------------------------------------------
+-- | @Sorted xs@: guarantees that xs is sorted.
+newtype SortedList a = Sorted {getSorted :: [a]}
+ deriving ( Eq, Ord, Show, Read
+#ifndef NO_TYPEABLE
+ , Typeable
+#endif
+ )
+
+instance Functor SortedList where
+ fmap f (Sorted x) = Sorted (map f x)
+
+instance (Arbitrary a, Ord a) => Arbitrary (SortedList a) where
+ arbitrary = fmap (Sorted . sort) arbitrary
+
+ shrink (Sorted xs) =
+ [ Sorted xs'
+ | xs' <- map sort (shrink xs)
+ ]
+
+--------------------------------------------------------------------------
-- | @Positive x@: guarantees that @x \> 0@.
newtype Positive a = Positive {getPositive :: a}
deriving ( Eq, Ord, Show, Read
diff --git a/changelog b/changelog
index 54d5c77..8989ad4 100644
--- a/changelog
+++ b/changelog
@@ -1,7 +1,11 @@
-QuickCheck 2.12.1 (release 2018-09-06)
+QuickCheck 2.12.2 (released 2018-09-06)
+ * Fix infinite shrinking loop for fractional types.
+ * Add SortedList modifier.
+
+QuickCheck 2.12.1 (released 2018-09-06)
* Fix bug in 'classify'.
-QuickCheck 2.12 (release 2018-09-03)
+QuickCheck 2.12 (released 2018-09-03)
* Silently breaking changes!
- The Arbitrary instance for Word now generates only small
values, the same as Int
diff --git a/tests/Generators.hs b/tests/Generators.hs
index 35c1d75..51e9b56 100644
--- a/tests/Generators.hs
+++ b/tests/Generators.hs
@@ -4,7 +4,9 @@ import Test.QuickCheck.Gen.Unsafe
import Data.List
import Data.Int
import Data.Word
-import Data.Version (showVersion, parseVersion)
+import Data.Version
+import System.Exit
+import Data.Complex
import Text.ParserCombinators.ReadP (readP_to_S)
newtype Path a = Path [a] deriving (Show, Functor)
@@ -16,9 +18,10 @@ instance Arbitrary a => Arbitrary (Path a) where
where
pathFrom x = sized $ \n ->
fmap (x:) $
- oneof $
- [return []] ++
- [resize (n-1) (pathFrom y) | n > 0, y <- shrink x]
+ case shrink x of
+ [] -> return []
+ _ | n == 0 -> return []
+ ys -> oneof [resize (n-1) (pathFrom y) | y <- ys]
shrink (Path xs) = map Path [ ys | ys <- inits xs, length ys > 0 && length ys < length xs ]
@@ -141,6 +144,38 @@ prop_reachesBound_Word16 = reachesBound :: Word16 -> Property
prop_reachesBound_Word32 = reachesBound :: Word32 -> Property
prop_reachesBound_Word64 = reachesBound :: Word64 -> Property
+-- Shrinking should not loop.
+noShrinkingLoop :: (Eq a, Arbitrary a) => Path a -> Bool
+noShrinkingLoop (Path (x:xs)) = x `notElem` xs
+
+prop_no_shrinking_loop_Unit = noShrinkingLoop :: Path () -> Bool
+prop_no_shrinking_loop_Bool = noShrinkingLoop :: Path Bool -> Bool
+prop_no_shrinking_loop_Ordering = noShrinkingLoop :: Path Ordering -> Bool
+prop_no_shrinking_loop_Maybe = noShrinkingLoop :: Path (Maybe Int) -> Bool
+prop_no_shrinking_loop_Either = noShrinkingLoop :: Path (Either Int Int) -> Bool
+prop_no_shrinking_loop_List = noShrinkingLoop :: Path [Int] -> Bool
+prop_no_shrinking_loop_Ratio = noShrinkingLoop :: Path Rational -> Bool
+prop_no_shrinking_loop_Complex = noShrinkingLoop :: Path (Complex Double) -> Bool
+prop_no_shrinking_loop_Fixed = noShrinkingLoop :: Path (Fixed Int) -> Bool
+prop_no_shrinking_loop_Pair = noShrinkingLoop :: Path (Int, Int) -> Bool
+prop_no_shrinking_loop_Triple = noShrinkingLoop :: Path (Int, Int, Int) -> Bool
+prop_no_shrinking_loop_Integer = noShrinkingLoop :: Path Integer -> Bool
+prop_no_shrinking_loop_Int = noShrinkingLoop :: Path Int -> Bool
+prop_no_shrinking_loop_Int8 = noShrinkingLoop :: Path Int8 -> Bool
+prop_no_shrinking_loop_Int16 = noShrinkingLoop :: Path Int16 -> Bool
+prop_no_shrinking_loop_Int32 = noShrinkingLoop :: Path Int32 -> Bool
+prop_no_shrinking_loop_Int64 = noShrinkingLoop :: Path Int64 -> Bool
+prop_no_shrinking_loop_Word = noShrinkingLoop :: Path Word -> Bool
+prop_no_shrinking_loop_Word8 = noShrinkingLoop :: Path Word8 -> Bool
+prop_no_shrinking_loop_Word16 = noShrinkingLoop :: Path Word16 -> Bool
+prop_no_shrinking_loop_Word32 = noShrinkingLoop :: Path Word32 -> Bool
+prop_no_shrinking_loop_Word64 = noShrinkingLoop :: Path Word64 -> Bool
+prop_no_shrinking_loop_Char = noShrinkingLoop :: Path Char -> Bool
+prop_no_shrinking_loop_Float = noShrinkingLoop :: Path Float -> Bool
+prop_no_shrinking_loop_Double = noShrinkingLoop :: Path Double -> Bool
+prop_no_shrinking_loop_Version = noShrinkingLoop :: Path Version -> Bool
+prop_no_shrinking_loop_ExitCode = noShrinkingLoop :: Path ExitCode -> Bool
+
-- Bad shrink: infinite list
--
-- remove unexpectedFailure in prop_B1, shrinking should not loop forever.