Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-QuickCheck for openSUSE:Factory
checked in at 2023-06-22 23:25:32
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-QuickCheck (Old)
and /work/SRC/openSUSE:Factory/.ghc-QuickCheck.new.15902 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-QuickCheck"
Thu Jun 22 23:25:32 2023 rev:26 rq:1094445 version:2.14.3
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-QuickCheck/ghc-QuickCheck.changes
2023-04-04 21:22:47.526002812 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-QuickCheck.new.15902/ghc-QuickCheck.changes
2023-06-22 23:25:59.969822732 +0200
@@ -1,0 +2,17 @@
+Wed May 31 15:38:24 UTC 2023 - Peter Simons <psim...@suse.com>
+
+- Update QuickCheck to version 2.14.3.
+ QuickCheck 2.14.3 (released 2023-05-31)
+ * Add shrinkBoundedEnum (thanks to Jonathan Knowles)
+ * Add discardAfter for discarding tests on timeout (thanks to Justus
Sagemüller)
+ * Add assertWith for monadic testing (thanks to KtorZ)
+ * Add functionElements to Test.QuickCheck.Function (thanks to Oleg
Grenrus)
+ * Add Arbitrary instance for Newline (thanks to Daniel Bramucci)
+ * Improve Arbitrary instances for Float and Double (thanks to Oleg
Grenrus)
+ * Improve arbitrarySizedFractional (thanks to Bodigrim)
+ * Fix shrinkRealFrac and shrinkDecimal, which were broken
+ * Speed up printing of progress messages (thanks to Bodigrim)
+ * Add COMPLETE pragmas for Fn and family (thanks to ilkecan)
+ * Make templateHaskell flag manual (thanks to Oleg Grenrus)
+
+-------------------------------------------------------------------
Old:
----
QuickCheck-2.14.2.tar.gz
New:
----
QuickCheck-2.14.3.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-QuickCheck.spec ++++++
--- /var/tmp/diff_new_pack.1ehPz7/_old 2023-06-22 23:26:00.497825424 +0200
+++ /var/tmp/diff_new_pack.1ehPz7/_new 2023-06-22 23:26:00.501825445 +0200
@@ -20,7 +20,7 @@
%global pkgver %{pkg_name}-%{version}
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.14.2
+Version: 2.14.3
Release: 0
Summary: Automatic testing of Haskell programs
License: BSD-3-Clause
++++++ QuickCheck-2.14.2.tar.gz -> QuickCheck-2.14.3.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/QuickCheck.cabal
new/QuickCheck-2.14.3/QuickCheck.cabal
--- old/QuickCheck-2.14.2/QuickCheck.cabal 2020-11-14 22:49:32.000000000
+0100
+++ new/QuickCheck-2.14.3/QuickCheck.cabal 2023-05-31 17:36:07.000000000
+0200
@@ -1,5 +1,5 @@
Name: QuickCheck
-Version: 2.14.2
+Version: 2.14.3
Cabal-Version: >= 1.10
Build-type: Simple
License: BSD3
@@ -57,15 +57,17 @@
source-repository this
type: git
location: https://github.com/nick8325/quickcheck
- tag: 2.14.2
+ tag: 2.14.3
flag templateHaskell
Description: Build Test.QuickCheck.All, which uses Template Haskell.
Default: True
+ Manual: True
flag old-random
Description: Build against a pre-1.2.0 version of the random package.
Default: False
+ Manual: False
library
Hs-source-dirs: src
@@ -114,7 +116,10 @@
if impl(ghc) && flag(templateHaskell)
Build-depends: template-haskell >= 2.4
- Other-Extensions: TemplateHaskell
+ if impl(ghc >=8.0)
+ Other-Extensions: TemplateHaskellQuotes
+ else
+ Other-Extensions: TemplateHaskell
Exposed-Modules: Test.QuickCheck.All
else
cpp-options: -DNO_TEMPLATE_HASKELL
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/README new/QuickCheck-2.14.3/README
--- old/QuickCheck-2.14.2/README 2019-03-30 09:37:55.000000000 +0100
+++ new/QuickCheck-2.14.3/README 2021-07-09 19:44:12.000000000 +0200
@@ -1,8 +1,6 @@
This is QuickCheck 2, a library for random testing of program properties.
-Install it in the usual way:
-
-$ cabal install
+Add `QuickCheck` to your package dependencies to use it in tests or REPL.
The quickcheck-instances [1] companion package provides instances for types in
Haskell Platform packages at the cost of additional dependencies.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/changelog
new/QuickCheck-2.14.3/changelog
--- old/QuickCheck-2.14.2/changelog 2020-11-14 22:48:45.000000000 +0100
+++ new/QuickCheck-2.14.3/changelog 2023-05-31 17:23:14.000000000 +0200
@@ -1,3 +1,16 @@
+QuickCheck 2.14.3 (released 2023-05-31)
+ * Add shrinkBoundedEnum (thanks to Jonathan Knowles)
+ * Add discardAfter for discarding tests on timeout (thanks to Justus
Sagemüller)
+ * Add assertWith for monadic testing (thanks to KtorZ)
+ * Add functionElements to Test.QuickCheck.Function (thanks to Oleg
Grenrus)
+ * Add Arbitrary instance for Newline (thanks to Daniel Bramucci)
+ * Improve Arbitrary instances for Float and Double (thanks to Oleg
Grenrus)
+ * Improve arbitrarySizedFractional (thanks to Bodigrim)
+ * Fix shrinkRealFrac and shrinkDecimal, which were broken
+ * Speed up printing of progress messages (thanks to Bodigrim)
+ * Add COMPLETE pragmas for Fn and family (thanks to ilkecan)
+ * Make templateHaskell flag manual (thanks to Oleg Grenrus)
+
QuickCheck 2.14.2 (released 2020-11-14)
* Add Arbitrary instances for Tree (thanks to Oleg Grenrus)
* GHC 9.0 compatibility (thanks to Vilem-Benjamin Liepelt)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/src/Test/QuickCheck/All.hs
new/QuickCheck-2.14.3/src/Test/QuickCheck/All.hs
--- old/QuickCheck-2.14.2/src/Test/QuickCheck/All.hs 2020-11-14
22:47:20.000000000 +0100
+++ new/QuickCheck-2.14.3/src/Test/QuickCheck/All.hs 2023-03-09
14:43:10.000000000 +0100
@@ -1,4 +1,9 @@
-{-# LANGUAGE TemplateHaskell, Rank2Types, CPP #-}
+{-# LANGUAGE Rank2Types, CPP #-}
+#if __GLASGOW_HASKELL__ >= 800
+{-# LANGUAGE TemplateHaskellQuotes #-}
+#else
+{-# LANGUAGE TemplateHaskell #-}
+#endif
#ifndef NO_SAFE_HASKELL
{-# LANGUAGE Trustworthy #-}
#endif
@@ -24,7 +29,7 @@
import Test.QuickCheck.Property hiding (Result)
import Test.QuickCheck.Test
import Data.Char
-import Data.List
+import Data.List (isPrefixOf, nubBy)
import Control.Monad
import qualified System.IO as S
@@ -44,7 +49,7 @@
-- property, the same scoping problems pop up as in 'quickCheckAll':
-- see the note there about @return []@.
polyQuickCheck :: Name -> ExpQ
-polyQuickCheck x = [| quickCheck $(monomorphic x) |]
+polyQuickCheck x = [| quickCheck |] `appE` monomorphic x
-- | Test a polymorphic property, defaulting all type variables to 'Integer'.
-- This is just a convenience function that combines 'verboseCheck' and
'monomorphic'.
@@ -53,7 +58,7 @@
-- property, the same scoping problems pop up as in 'quickCheckAll':
-- see the note there about @return []@.
polyVerboseCheck :: Name -> ExpQ
-polyVerboseCheck x = [| verboseCheck $(monomorphic x) |]
+polyVerboseCheck x = [| verboseCheck |] `appE` monomorphic x
type Error = forall a. String -> a
@@ -132,7 +137,7 @@
-- 'forAllProperties' has the same issue with scoping as 'quickCheckAll':
-- see the note there about @return []@.
forAllProperties :: Q Exp -- :: (Property -> IO Result) -> IO Bool
-forAllProperties = [| runQuickCheckAll $allProperties |]
+forAllProperties = [| runQuickCheckAll |] `appE` allProperties
-- | List all properties in the current module.
--
@@ -155,10 +160,15 @@
quickCheckOne :: (Int, String) -> Q [Exp]
quickCheckOne (l, x) = do
exists <- (warning x >> return False) `recover` (reify (mkName x) >>
return True)
- if exists then sequence [ [| ($(stringE $ x ++ " from " ++ filename ++
":" ++ show l),
- property $(monomorphic (mkName x))) |] ]
+ if exists
+ then sequence
+ [ tupE
+ [ stringE $ x ++ " from " ++ filename ++ ":" ++ show l
+ , [| property |] `appE` monomorphic (mkName x)
+ ]
+ ]
else return []
- [| $(fmap (ListE . concat) (mapM quickCheckOne idents)) :: [(String,
Property)] |]
+ fmap (ListE . concat) (mapM quickCheckOne idents) `sigE` [t| [(String,
Property)] |]
readUTF8File name = S.openFile name S.ReadMode >>=
set_utf8_io_enc >>=
@@ -195,7 +205,7 @@
-- of the module, which means that the later call to 'quickCheckAll'
-- can see everything that was defined before the @return []@. Yikes!
quickCheckAll :: Q Exp
-quickCheckAll = [| $(forAllProperties) quickCheckResult |]
+quickCheckAll = forAllProperties `appE` [| quickCheckResult |]
-- | Test all properties in the current module.
-- This is just a convenience function that combines 'quickCheckAll' and
'verbose'.
@@ -203,7 +213,7 @@
-- 'verboseCheckAll' has the same issue with scoping as 'quickCheckAll':
-- see the note there about @return []@.
verboseCheckAll :: Q Exp
-verboseCheckAll = [| $(forAllProperties) verboseCheckResult |]
+verboseCheckAll = forAllProperties `appE` [| verboseCheckResult |]
runQuickCheckAll :: [(String, Property)] -> (Property -> IO Result) -> IO Bool
runQuickCheckAll ps qc =
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/src/Test/QuickCheck/Arbitrary.hs
new/QuickCheck-2.14.3/src/Test/QuickCheck/Arbitrary.hs
--- old/QuickCheck-2.14.2/src/Test/QuickCheck/Arbitrary.hs 2020-11-14
22:47:20.000000000 +0100
+++ new/QuickCheck-2.14.3/src/Test/QuickCheck/Arbitrary.hs 2023-05-16
11:54:28.000000000 +0200
@@ -68,6 +68,7 @@
, shrinkMapBy -- :: (a -> b) -> (b -> a) -> (a -> [a]) -> b ->
[b]
, shrinkIntegral -- :: Integral a => a -> [a]
, shrinkRealFrac -- :: RealFrac a => a -> [a]
+ , shrinkBoundedEnum -- :: (Bounded a, Enum a) => a -> [a]
, shrinkDecimal -- :: RealFrac a => a -> [a]
-- ** Helper functions for implementing coarbitrary
, coarbitraryIntegral -- :: Integral a => a -> Gen b -> Gen b
@@ -137,6 +138,15 @@
import Data.Version (Version (..))
+#if defined(MIN_VERSION_base)
+#if MIN_VERSION_base(4,2,0)
+import System.IO
+ ( Newline(..)
+ , NewlineMode(..)
+ )
+#endif
+#endif
+
import Control.Monad
( liftM
, liftM2
@@ -684,11 +694,55 @@
)
instance Arbitrary Float where
- arbitrary = arbitrarySizedFractional
+ arbitrary = oneof
+ -- generate 0..1 numbers with full precision
+ [ genFloat
+ -- generate integral numbers
+ , fromIntegral <$> (arbitrary :: Gen Int)
+ -- generate fractions with small denominators
+ , smallDenominators
+ -- uniform -size..size with with denominators ~ size
+ , uniform
+ -- and uniform -size..size with higher precision
+ , arbitrarySizedFractional
+ ]
+ where
+ smallDenominators = sized $ \n -> do
+ i <- chooseInt (0, n)
+ pure (fromRational (streamNth i rationalUniverse))
+
+ uniform = sized $ \n -> do
+ let n' = toInteger n
+ b <- chooseInteger (1, max 1 n')
+ a <- chooseInteger ((-n') * b, n' * b)
+ return (fromRational (a % b))
+
shrink = shrinkDecimal
instance Arbitrary Double where
- arbitrary = arbitrarySizedFractional
+ arbitrary = oneof
+ -- generate 0..1 numbers with full precision
+ [ genDouble
+ -- generate integral numbers
+ , fromIntegral <$> (arbitrary :: Gen Int)
+ -- generate fractions with small denominators
+ , smallDenominators
+ -- uniform -size..size with with denominators ~ size
+ , uniform
+ -- and uniform -size..size with higher precision
+ , arbitrarySizedFractional
+ ]
+ where
+ smallDenominators = sized $ \n -> do
+ i <- chooseInt (0, n)
+ pure (fromRational (streamNth i rationalUniverse))
+
+ uniform = sized $ \n -> do
+ let n' = toInteger n
+ b <- chooseInteger (1, max 1 n')
+ a <- chooseInteger ((-n') * b, n' * b)
+ return (fromRational (a % b))
+
shrink = shrinkDecimal
instance Arbitrary CChar where
@@ -987,7 +1041,25 @@
shrink (ExitFailure x) = ExitSuccess : [ ExitFailure x' | x' <- shrink x ]
shrink _ = []
+#if defined(MIN_VERSION_base)
+#if MIN_VERSION_base(4,2,0)
+instance Arbitrary Newline where
+ arbitrary = elements [LF, CRLF]
+
+ -- The behavior of code for LF is generally simpler than for CRLF
+ -- See the documentation for this type, which states that Haskell
+ -- Internally always assumes newlines are \n and this type represents
+ -- how to translate that to and from the outside world, where LF means
+ -- no translation.
+ shrink LF = []
+ shrink CRLF = [LF]
+
+instance Arbitrary NewlineMode where
+ arbitrary = NewlineMode <$> arbitrary <*> arbitrary
+ shrink (NewlineMode inNL outNL) = [NewlineMode inNL' outNL' | (inNL',
outNL') <- shrink (inNL, outNL)]
+#endif
+#endif
-- ** Helper functions for implementing arbitrary
@@ -1024,17 +1096,14 @@
inBounds :: Integral a => (Int -> a) -> Gen Int -> Gen a
inBounds fi g = fmap fi (g `suchThat` (\x -> toInteger x == toInteger (fi x)))
--- | Generates a fractional number. The number can be positive or negative
+-- | Uniformly generates a fractional number. The number can be positive or
negative
-- and its maximum absolute value depends on the size parameter.
arbitrarySizedFractional :: Fractional a => Gen a
arbitrarySizedFractional =
- sized $ \n ->
- let n' = toInteger n in
- do b <- chooseInteger (1, precision)
- a <- chooseInteger ((-n') * b, n' * b)
- return (fromRational (a % b))
- where
- precision = 9999999999999 :: Integer
+ sized $ \n -> do
+ denom <- chooseInt (1, max 1 n)
+ numer <- chooseInt (-n*denom, n*denom)
+ pure $ fromIntegral numer / fromIntegral denom
-- Useful for getting at minBound and maxBound without having to
-- fiddle around with asTypeOf.
@@ -1119,7 +1188,7 @@
-- shrinkOrderedList :: (Ord a, Arbitrary a) => [a] -> [[a]]
-- shrinkOrderedList = shrinkMap sort id
--
--- shrinkSet :: (Ord a, Arbitrary a) => Set a -> Set [a]
+-- shrinkSet :: (Ord a, Arbitrary a) => Set a -> [Set a]
-- shrinkSet = shrinkMap fromList toList
-- @
shrinkMap :: Arbitrary a => (a -> b) -> (b -> a) -> b -> [b]
@@ -1147,14 +1216,42 @@
(True, False) -> a + b < 0
(False, True) -> a + b > 0
+-- | Shrink an element of a bounded enumeration.
+--
+-- === __Example__
+--
+-- @
+-- data MyEnum = E0 | E1 | E2 | E3 | E4 | E5 | E6 | E7 | E8 | E9
+-- deriving (Bounded, Enum, Eq, Ord, Show)
+-- @
+--
+-- >>> shrinkBoundedEnum E9
+-- [E0,E5,E7,E8]
+--
+-- >>> shrinkBoundedEnum E5
+-- [E0,E3,E4]
+--
+-- >>> shrinkBoundedEnum E0
+-- []
+--
+shrinkBoundedEnum :: (Bounded a, Enum a, Eq a) => a -> [a]
+shrinkBoundedEnum a
+ | a == minBound =
+ []
+ | otherwise =
+ toEnum <$> filter (>= minBoundInt) (shrinkIntegral $ fromEnum a)
+ where
+ minBoundInt :: Int
+ minBoundInt = fromEnum (minBound `asTypeOf` a)
+
-- | Shrink a fraction, preferring numbers with smaller
-- numerators or denominators. See also 'shrinkDecimal'.
shrinkRealFrac :: RealFrac a => a -> [a]
shrinkRealFrac x
- | not (x == x) = 0 : take 10 (iterate (*2) 0) -- NaN
- | not (2*x+1>x) = 0 : takeWhile (<x) (iterate (*2) 0) -- infinity
+ | not (x == x) = 0 : takeWhile (< 1000) numbers -- NaN
+ | x > 0 && not (2*x+1>x) = 0 : takeWhile (<x) numbers -- infinity
| x < 0 = negate x:map negate (shrinkRealFrac (negate x))
- | otherwise =
+ | otherwise = -- x is finite and >= 0
-- To ensure termination
filter (\y -> abs y < abs x) $
-- Try shrinking to an integer first
@@ -1168,14 +1265,16 @@
where
num = numerator (toRational x)
denom = denominator (toRational x)
+ numbers = iterate (*2) 1
-- | Shrink a real number, preferring numbers with shorter
-- decimal representations. See also 'shrinkRealFrac'.
shrinkDecimal :: RealFrac a => a -> [a]
shrinkDecimal x
- | not (x == x) = 0 : take 10 (iterate (*2) 0) -- NaN
- | not (2*abs x+1>abs x) = 0 : takeWhile (<x) (iterate (*2) 0) -- infinity
- | otherwise =
+ | not (x == x) = 0 : takeWhile (< 1000) numbers -- NaN
+ | not (2*abs x+1>abs x) = 0 : takeWhile (<x) numbers -- infinity
+ | x < 0 = negate x:map negate (shrinkDecimal (negate x))
+ | otherwise = -- x is finite and >= 0
-- e.g. shrink pi =
-- shrink 3 ++ map (/ 10) (shrink 31) ++
-- map (/ 100) (shrink 314) + ...,
@@ -1187,6 +1286,9 @@
n <- m:shrink m,
let y = fromRational (fromInteger n / precision),
abs y < abs x ]
+ where
+ -- 1, 2, 3, ..., 10, 20, 30, ..., 100, 200, 300, etc.
+ numbers = concat $ iterate (map (*10)) (map fromInteger [1..9])
--------------------------------------------------------------------------
-- ** CoArbitrary
@@ -1447,6 +1549,17 @@
instance CoArbitrary Version where
coarbitrary (Version a b) = coarbitrary (a, b)
+#if defined(MIN_VERSION_base)
+#if MIN_VERSION_base(4,2,0)
+instance CoArbitrary Newline where
+ coarbitrary LF = variant 0
+ coarbitrary CRLF = variant 1
+
+instance CoArbitrary NewlineMode where
+ coarbitrary (NewlineMode inNL outNL) = coarbitrary inNL . coarbitrary outNL
+#endif
+#endif
+
-- ** Helpers for implementing coarbitrary
-- | A 'coarbitrary' implementation for integral numbers.
@@ -1482,5 +1595,41 @@
infiniteList :: Arbitrary a => Gen [a]
infiniteList = infiniteListOf arbitrary
+
+--------------------------------------------------------------------------
+-- ** Rational helper
+
+infixr 5 :<
+data Stream a = !a :< Stream a
+
+streamNth :: Int -> Stream a -> a
+streamNth n (x :< xs) | n <= 0 = x
+ | otherwise = streamNth (n - 1) xs
+
+-- We read into this stream only with ~size argument,
+-- so it's ok to have it as CAF.
+--
+rationalUniverse :: Stream Rational
+rationalUniverse = 0 :< 1 :< (-1) :< go leftSideStream
+ where
+ go (x :< xs) =
+ let nx = -x
+ rx = recip x
+ nrx = -rx
+ in nx `seq` rx `seq` nrx `seq` (x :< rx :< nx :< nrx :< go xs)
+
+-- All the rational numbers on the left side of the Calkin-Wilf tree,
+-- in breadth-first order.
+leftSideStream :: Stream Rational
+leftSideStream = (1 % 2) :< go leftSideStream
+ where
+ go (x :< xs) =
+ lChild `seq` rChild `seq`
+ (lChild :< rChild :< go xs)
+ where
+ nd = numerator x + denominator x
+ lChild = numerator x % nd
+ rChild = nd % denominator x
+
--------------------------------------------------------------------------
-- the end.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/src/Test/QuickCheck/Exception.hs
new/QuickCheck-2.14.3/src/Test/QuickCheck/Exception.hs
--- old/QuickCheck-2.14.2/src/Test/QuickCheck/Exception.hs 2020-06-29
16:29:29.000000000 +0200
+++ new/QuickCheck-2.14.3/src/Test/QuickCheck/Exception.hs 2023-05-16
11:37:36.000000000 +0200
@@ -5,6 +5,9 @@
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP #-}
+#ifndef NO_SAFE_HASKELL
+{-# LANGUAGE Safe #-}
+#endif
module Test.QuickCheck.Exception where
#if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ < 700)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/src/Test/QuickCheck/Features.hs
new/QuickCheck-2.14.3/src/Test/QuickCheck/Features.hs
--- old/QuickCheck-2.14.2/src/Test/QuickCheck/Features.hs 2020-06-29
16:29:29.000000000 +0200
+++ new/QuickCheck-2.14.3/src/Test/QuickCheck/Features.hs 2023-05-16
11:38:07.000000000 +0200
@@ -1,3 +1,7 @@
+{-# LANGUAGE CPP #-}
+#ifndef NO_SAFE_HASKELL
+{-# LANGUAGE Safe #-}
+#endif
{-# OPTIONS_HADDOCK hide #-}
module Test.QuickCheck.Features where
@@ -9,7 +13,7 @@
import Test.QuickCheck.Text
import qualified Data.Set as Set
import Data.Set(Set)
-import Data.List
+import Data.List (intersperse)
import Data.IORef
import Data.Maybe
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/src/Test/QuickCheck/Function.hs
new/QuickCheck-2.14.3/src/Test/QuickCheck/Function.hs
--- old/QuickCheck-2.14.2/src/Test/QuickCheck/Function.hs 2020-11-14
22:47:20.000000000 +0100
+++ new/QuickCheck-2.14.3/src/Test/QuickCheck/Function.hs 2023-03-09
14:43:10.000000000 +0100
@@ -48,6 +48,7 @@
, functionIntegral
, functionRealFrac
, functionBoundedEnum
+ , functionElements
, functionVoid
, functionMapWith
, functionEitherWith
@@ -83,6 +84,15 @@
import Data.Functor.Identity
import qualified Data.Monoid as Monoid
+#if defined(MIN_VERSION_base)
+#if MIN_VERSION_base(4,2,0)
+import System.IO
+ ( Newline(..)
+ , NewlineMode(..)
+ )
+#endif
+#endif
+
#ifndef NO_FIXED
import Data.Fixed
#endif
@@ -165,7 +175,11 @@
-- Use only for small types (i.e. not integers): creates
-- the list @['minBound'..'maxBound']@!
functionBoundedEnum :: (Eq a, Bounded a, Enum a) => (a->b) -> (a:->b)
-functionBoundedEnum f = Table [(x,f x) | x <- [minBound..maxBound]]
+functionBoundedEnum = functionElements [minBound..maxBound]
+
+-- | Provides a 'Function' instance for small finite types.
+functionElements :: Eq a => [a] -> (a->b) -> (a:->b)
+functionElements xs f = Table [(x,f x) | x <- xs]
-- | Provides a 'Function' instance for types with 'RealFrac'.
functionRealFrac :: RealFrac a => (a->b) -> (a:->b)
@@ -367,6 +381,25 @@
instance Function Word64 where
function = functionIntegral
+#if defined(MIN_VERSION_base)
+#if MIN_VERSION_base(4,2,0)
+instance Function Newline where
+ function = functionMap g h
+ where
+ g LF = False
+ g CRLF = True
+
+ h False = LF
+ h True = CRLF
+
+instance Function NewlineMode where
+ function = functionMap g h
+ where
+ g (NewlineMode inNL outNL) = (inNL,outNL)
+ h (inNL,outNL) = NewlineMode inNL outNL
+#endif
+#endif
+
-- instances for Data.Monoid newtypes
instance Function a => Function (Monoid.Dual a) where
@@ -525,6 +558,9 @@
pattern Fn :: (a -> b) -> Fun a b
#endif
pattern Fn f <- (applyFun -> f)
+#if __GLASGOW_HASKELL__ >= 802
+{-# COMPLETE Fn #-}
+#endif
-- | A modifier for testing binary functions.
--
@@ -534,12 +570,18 @@
pattern Fn2 :: (a -> b -> c) -> Fun (a, b) c
#endif
pattern Fn2 f <- (applyFun2 -> f)
+#if __GLASGOW_HASKELL__ >= 802
+{-# COMPLETE Fn2 #-}
+#endif
-- | A modifier for testing ternary functions.
#if __GLASGOW_HASKELL__ >= 800
pattern Fn3 :: (a -> b -> c -> d) -> Fun (a, b, c) d
#endif
pattern Fn3 f <- (applyFun3 -> f)
+#if __GLASGOW_HASKELL__ >= 802
+{-# COMPLETE Fn3 #-}
+#endif
#endif
mkFun :: (a :-> b) -> b -> Fun a b
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/src/Test/QuickCheck/Gen.hs
new/QuickCheck-2.14.3/src/Test/QuickCheck/Gen.hs
--- old/QuickCheck-2.14.2/src/Test/QuickCheck/Gen.hs 2020-10-15
16:13:09.000000000 +0200
+++ new/QuickCheck-2.14.3/src/Test/QuickCheck/Gen.hs 2023-05-16
11:35:53.000000000 +0200
@@ -2,6 +2,9 @@
#ifndef NO_ST_MONAD
{-# LANGUAGE Rank2Types #-}
#endif
+#ifndef NO_SAFE_HASKELL
+{-# LANGUAGE Safe #-}
+#endif
-- | Test case generation.
--
-- __Note__: the contents of this module (except for the definition of
@@ -32,11 +35,11 @@
( Applicative(..) )
import Test.QuickCheck.Random
-import Data.List
+import Data.List (sortBy)
import Data.Ord
import Data.Maybe
#ifndef NO_SPLITMIX
-import System.Random.SplitMix(bitmaskWithRejection64', SMGen, nextInteger)
+import System.Random.SplitMix(bitmaskWithRejection64', nextInteger,
nextDouble, nextFloat, SMGen)
#endif
import Data.Word
import Data.Int
@@ -240,6 +243,23 @@
mapM_ print cases
--------------------------------------------------------------------------
+-- ** Floating point
+
+-- | Generate 'Double' in 0..1 range
+genDouble :: Gen Double
+
+-- | Generate 'Float' in 0..1 range
+genFloat :: Gen Float
+
+#ifndef NO_SPLITMIX
+genDouble = MkGen $ \(QCGen g) _ -> fst (nextDouble g)
+genFloat = MkGen $ \(QCGen g) _ -> fst (nextFloat g)
+#else
+genDouble = choose (0,1)
+genFloat = choose (0,1)
+#endif
+
+--------------------------------------------------------------------------
-- ** Common generator combinators
-- | Generates a value that satisfies a predicate.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/src/Test/QuickCheck/Monadic.hs
new/QuickCheck-2.14.3/src/Test/QuickCheck/Monadic.hs
--- old/QuickCheck-2.14.2/src/Test/QuickCheck/Monadic.hs 2020-06-29
16:29:29.000000000 +0200
+++ new/QuickCheck-2.14.3/src/Test/QuickCheck/Monadic.hs 2021-07-09
19:44:12.000000000 +0200
@@ -56,6 +56,7 @@
-- * Monadic specification combinators
, run
, assert
+ , assertWith
, pre
, wp
, pick
@@ -150,6 +151,28 @@
assert True = return ()
assert False = fail "Assertion failed"
+-- | Like 'assert' but allows caller to specify an explicit message to show on
failure.
+--
+-- __Example:__
+--
+-- @
+-- do
+-- assertWith True "My first predicate."
+-- assertWith False "My other predicate."
+-- ...
+-- @
+--
+-- @
+-- Assertion failed (after 2 tests):
+-- Passed: My first predicate
+-- Failed: My other predicate
+-- @
+assertWith :: Monad m => Bool -> String -> PropertyM m ()
+assertWith condition msg = do
+ let prefix = if condition then "Passed: " else "Failed: "
+ monitor $ counterexample $ prefix ++ msg
+ assert condition
+
-- should think about strictness/exceptions here
-- | Tests preconditions. Unlike 'assert' this does not cause the
-- property to fail, rather it discards them just like using the
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/src/Test/QuickCheck/Property.hs
new/QuickCheck-2.14.3/src/Test/QuickCheck/Property.hs
--- old/QuickCheck-2.14.2/src/Test/QuickCheck/Property.hs 2020-06-29
16:29:29.000000000 +0200
+++ new/QuickCheck-2.14.3/src/Test/QuickCheck/Property.hs 2023-03-12
12:44:22.000000000 +0100
@@ -217,12 +217,12 @@
fmap f (MkRose x rs) = MkRose (f x) [ fmap f r | r <- rs ]
instance Applicative Rose where
- pure = return
+ pure x = MkRose x []
-- f must be total
(<*>) = liftM2 ($)
instance Monad Rose where
- return x = MkRose x []
+ return = pure
-- k must be total
m >>= k = joinRose (fmap k m)
@@ -778,7 +778,20 @@
--
-- Bad: @prop_foo a b c = ...; main = quickCheck (within 1000000 prop_foo)@
within :: Testable prop => Int -> prop -> Property
-within n = mapRoseResult f
+within n = onTimeout
+ (failed { reason = "Timeout of " ++ show n ++ " microseconds exceeded." })
+ n
+
+-- | Discards the test case if it does not complete within the given
+-- number of microseconds. This can be useful when testing algorithms
+-- that have pathological cases where they run extremely slowly.
+discardAfter :: Testable prop => Int -> prop -> Property
+discardAfter n = onTimeout
+ (rejected { reason = "Timeout of " ++ show n ++ " microseconds exceeded." })
+ n
+
+onTimeout :: Testable prop => Result -> Int -> prop -> Property
+onTimeout timeoutResult n = mapRoseResult f
where
f rose = ioRose $ do
let m `orError` x = fmap (fromMaybe x) m
@@ -787,12 +800,12 @@
res' <- timeout n (protectResult (return res)) `orError`
timeoutResult
return (MkRose res' (map f roses))
-
- timeoutResult = failed { reason = "Timeout of " ++ show n ++ "
microseconds exceeded." }
#ifdef NO_TIMEOUT
timeout _ = fmap Just
#endif
+
+
-- | Explicit universal quantification: uses an explicitly given
-- test case generator.
forAll :: (Show a, Testable prop)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/src/Test/QuickCheck/State.hs
new/QuickCheck-2.14.3/src/Test/QuickCheck/State.hs
--- old/QuickCheck-2.14.2/src/Test/QuickCheck/State.hs 2020-06-29
16:29:29.000000000 +0200
+++ new/QuickCheck-2.14.3/src/Test/QuickCheck/State.hs 2023-05-16
11:37:41.000000000 +0200
@@ -1,3 +1,7 @@
+{-# LANGUAGE CPP #-}
+#ifndef NO_SAFE_HASKELL
+{-# LANGUAGE Safe #-}
+#endif
{-# OPTIONS_HADDOCK hide #-}
-- | QuickCheck's internal state. Internal QuickCheck module.
module Test.QuickCheck.State where
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/src/Test/QuickCheck/Text.hs
new/QuickCheck-2.14.3/src/Test/QuickCheck/Text.hs
--- old/QuickCheck-2.14.2/src/Test/QuickCheck/Text.hs 2020-06-29
16:29:29.000000000 +0200
+++ new/QuickCheck-2.14.3/src/Test/QuickCheck/Text.hs 2023-05-30
10:38:13.000000000 +0200
@@ -1,3 +1,7 @@
+{-# LANGUAGE CPP #-}
+#ifndef NO_SAFE_HASKELL
+{-# LANGUAGE Safe #-}
+#endif
{-# OPTIONS_HADDOCK hide #-}
-- | Terminal control and text helper functions. Internal QuickCheck module.
module Test.QuickCheck.Text
@@ -43,7 +47,7 @@
)
import Data.IORef
-import Data.List
+import Data.List (intersperse, transpose)
import Text.Printf
import Test.QuickCheck.Exception
@@ -222,11 +226,11 @@
putLine tm s = putPart tm (s ++ "\n")
putTemp tm@(MkTerminal _ tmp _ err) s =
- do n <- readIORef tmp
- err $
- replicate n ' ' ++ replicate n '\b' ++
- s ++ [ '\b' | _ <- s ]
- writeIORef tmp (length s)
+ do oldLen <- readIORef tmp
+ let newLen = length s
+ maxLen = max newLen oldLen
+ err $ s ++ replicate (maxLen - newLen) ' ' ++ replicate maxLen '\b'
+ writeIORef tmp newLen
--------------------------------------------------------------------------
-- the end.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/src/Test/QuickCheck.hs
new/QuickCheck-2.14.3/src/Test/QuickCheck.hs
--- old/QuickCheck-2.14.2/src/Test/QuickCheck.hs 2020-06-29
16:29:29.000000000 +0200
+++ new/QuickCheck-2.14.3/src/Test/QuickCheck.hs 2023-03-12
12:15:19.000000000 +0100
@@ -81,6 +81,7 @@
, shrinkMapBy
, shrinkIntegral
, shrinkRealFrac
+ , shrinkBoundedEnum
, shrinkDecimal
-- ** Lifting of 'Arbitrary' to unary and binary type constructors
@@ -269,6 +270,7 @@
, noShrinking
, withMaxSuccess
, within
+ , discardAfter
, once
, again
, mapSize
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/tests/Generators.hs
new/QuickCheck-2.14.3/tests/Generators.hs
--- old/QuickCheck-2.14.2/tests/Generators.hs 2020-03-27 23:47:08.000000000
+0100
+++ new/QuickCheck-2.14.3/tests/Generators.hs 2023-03-09 14:43:10.000000000
+0100
@@ -1,7 +1,7 @@
{-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving, Rank2Types,
NoMonomorphismRestriction #-}
import Test.QuickCheck
import Test.QuickCheck.Gen.Unsafe
-import Data.List
+import Data.List (inits, sort, nub)
import Data.Int
import Data.Word
import Data.Version
@@ -204,5 +204,17 @@
prop_B1 :: B1 -> Property
prop_B1 (B1 n) = expectFailure $ n === n + 1
+-- Double properties:
+
+-- We occasionaly generate duplicates.
+prop_double_duplicate_list :: [Double] -> Property
+prop_double_duplicate_list xs = expectFailure $ nub xs === xs where
+ sorted = sort xs
+
+-- And enough numbers to show basic IEEE pit falls.
+prop_double_assoc :: Double -> Double -> Double -> Property
+prop_double_assoc x y z = expectFailure $ x + (y + z) === (x + y) + z
+
+
return []
main = do True <- $forAllProperties (quickCheckWithResult stdArgs { maxShrinks
= 10000 }); return ()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.14.2/tests/Split.hs
new/QuickCheck-2.14.3/tests/Split.hs
--- old/QuickCheck-2.14.2/tests/Split.hs 2019-03-30 09:37:55.000000000
+0100
+++ new/QuickCheck-2.14.3/tests/Split.hs 2023-03-09 14:43:10.000000000
+0100
@@ -1,6 +1,6 @@
import Test.QuickCheck
import Test.QuickCheck.Random
-import Data.List
+import Data.List (group, isPrefixOf, sort)
-- This type allows us to run integerVariant and get a list of bits out.
newtype Splits = Splits { unSplits :: [Bool] } deriving (Eq, Ord, Show)
