Hello community, here is the log from the commit of package ghc-QuickCheck for openSUSE:Factory checked in at 2016-05-31 12:24:32 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-QuickCheck (Old) and /work/SRC/openSUSE:Factory/.ghc-QuickCheck.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-QuickCheck" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-QuickCheck/ghc-QuickCheck.changes 2015-08-25 08:48:07.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-QuickCheck.new/ghc-QuickCheck.changes 2016-05-31 12:24:33.000000000 +0200 @@ -1,0 +2,11 @@ +Thu May 26 06:22:16 UTC 2016 - mimi.vx@gmail.com + +- update to 2.8.2 +* GHC 8 support +* Add Arbitrary and CoArbitrary instances for types in containers package +* Improve speed of shuffle combinator +* Only print to stderr if it's a terminal. +* Small changes: slightly improve documentation, remove redundant constraints + from some functions' types, small improvements to Test.QuickCheck.All. + +------------------------------------------------------------------- Old: ---- QuickCheck-2.8.1.tar.gz New: ---- QuickCheck-2.8.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-QuickCheck.spec ++++++ --- /var/tmp/diff_new_pack.LYJnlS/_old 2016-05-31 12:24:34.000000000 +0200 +++ /var/tmp/diff_new_pack.LYJnlS/_new 2016-05-31 12:24:34.000000000 +0200 @@ -21,7 +21,7 @@ %bcond_with tests Name: ghc-QuickCheck -Version: 2.8.1 +Version: 2.8.2 Release: 0 Summary: Automatic testing of Haskell programs License: BSD-3-Clause ++++++ QuickCheck-2.8.1.tar.gz -> QuickCheck-2.8.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.1/QuickCheck.cabal new/QuickCheck-2.8.2/QuickCheck.cabal --- old/QuickCheck-2.8.1/QuickCheck.cabal 2015-04-03 14:23:20.000000000 +0200 +++ new/QuickCheck-2.8.2/QuickCheck.cabal 2016-01-15 17:09:16.000000000 +0100 @@ -1,5 +1,5 @@ Name: QuickCheck -Version: 2.8.1 +Version: 2.8.2 Cabal-Version: >= 1.8 Build-type: Simple License: BSD3 @@ -37,7 +37,7 @@ source-repository this type: git location: https://github.com/nick8325/quickcheck - tag: 2.8.1 + tag: 2.8.2 flag base3 Description: Choose the new smaller, split-up base package. @@ -50,6 +50,7 @@ flag templateHaskell Description: Build Test.QuickCheck.All, which uses Template Haskell. + Default: True library -- Choose which library versions to use. @@ -92,6 +93,7 @@ cpp-options: -DNO_TRANSFORMERS if impl(ghc >= 6.12) && flag(templateHaskell) Build-depends: template-haskell >= 2.4 + Other-Extensions: TemplateHaskell Exposed-Modules: Test.QuickCheck.All else cpp-options: -DNO_TEMPLATE_HASKELL @@ -158,7 +160,7 @@ build-depends: base, containers, - QuickCheck == 2.8.1, + QuickCheck == 2.8.2, template-haskell >= 2.4, test-framework >= 0.4 && < 0.9 if flag(templateHaskell) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.1/Test/QuickCheck/All.hs new/QuickCheck-2.8.2/Test/QuickCheck/All.hs --- old/QuickCheck-2.8.1/Test/QuickCheck/All.hs 2015-04-03 14:23:20.000000000 +0200 +++ new/QuickCheck-2.8.2/Test/QuickCheck/All.hs 2016-01-15 17:09:16.000000000 +0100 @@ -2,6 +2,7 @@ #ifndef NO_SAFE_HASKELL {-# LANGUAGE Trustworthy #-} #endif + -- | Test all properties in the current module, using Template Haskell. -- You need to have a @{-\# LANGUAGE TemplateHaskell \#-}@ pragma in -- your module for any of these to work. @@ -66,29 +67,40 @@ let err msg = error $ msg ++ ": " ++ pprint ty0 (polys, ctx, ty) <- deconstructType err ty0 case polys of - [] -> return (VarE t) + [] -> return (expName t) _ -> do integer <- [t| Integer |] ty' <- monomorphiseType err integer ty - return (SigE (VarE t) ty') + return (SigE (expName t) ty') + +expName :: Name -> Exp +expName n = if isVar n then VarE n else ConE n + +-- See section 2.4 of the Haskell 2010 Language Report, plus support for "[]" +isVar :: Name -> Bool +isVar = let isVar' (c:_) = not (isUpper c || c `elem` ":[") + isVar' _ = True + in isVar' . nameBase infoType :: Info -> Type +#if __GLASGOW_HASKELL__ >= 711 +infoType (ClassOpI _ ty _) = ty +infoType (DataConI _ ty _) = ty +infoType (VarI _ ty _) = ty +#else infoType (ClassOpI _ ty _ _) = ty infoType (DataConI _ ty _ _) = ty infoType (VarI _ ty _ _) = ty +#endif deconstructType :: Error -> Type -> Q ([Name], Cxt, Type) deconstructType err ty0@(ForallT xs ctx ty) = do let plain (PlainTV _) = True -#ifndef MIN_VERSION_template_haskell - plain (KindedTV _ StarT) = True -#else -#if MIN_VERSION_template_haskell(2,8,0) +#if __GLASGOW_HASKELL__ >= 706 plain (KindedTV _ StarT) = True #else plain (KindedTV _ StarK) = True #endif -#endif plain _ = False unless (all plain xs) $ err "Higher-kinded type variables in type" return (map (\(PlainTV x) -> x) xs, ctx, ty) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.1/Test/QuickCheck/Arbitrary.hs new/QuickCheck-2.8.2/Test/QuickCheck/Arbitrary.hs --- old/QuickCheck-2.8.1/Test/QuickCheck/Arbitrary.hs 2015-04-03 14:23:20.000000000 +0200 +++ new/QuickCheck-2.8.2/Test/QuickCheck/Arbitrary.hs 2016-01-15 17:09:16.000000000 +0100 @@ -3,7 +3,10 @@ #ifndef NO_GENERICS {-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeOperators #-} {-# LANGUAGE FlexibleInstances, KindSignatures, ScopedTypeVariables #-} -{-# LANGUAGE MultiParamTypeClasses, OverlappingInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +#if __GLASGOW_HASKELL__ < 710 +{-# LANGUAGE OverlappingInstances #-} +#endif #endif #ifndef NO_SAFE_HASKELL {-# LANGUAGE Safe #-} @@ -52,6 +55,7 @@ -- imports import Control.Applicative +import Data.Foldable(toList) import System.Random(Random) import Test.QuickCheck.Gen import Test.QuickCheck.Gen.Unsafe @@ -115,6 +119,12 @@ import GHC.Generics #endif +import qualified Data.Set as Set +import qualified Data.Map as Map +import qualified Data.IntSet as IntSet +import qualified Data.IntMap as IntMap +import qualified Data.Sequence as Sequence + -------------------------------------------------------------------------- -- ** class Arbitrary @@ -122,7 +132,6 @@ class Arbitrary a where -- | A generator for values of the given type. arbitrary :: Gen a - arbitrary = error "no default generator" -- | Produces a (possibly) empty list of all the possible -- immediate shrinks of the given value. The default implementation @@ -195,7 +204,7 @@ #ifndef NO_GENERICS -- | Shrink a term to any of its immediate subterms, -- and also recursively shrink all subterms. -genericShrink :: (Generic a, Arbitrary a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) => a -> [a] +genericShrink :: (Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) => a -> [a] genericShrink x = subterms x ++ recursivelyShrink x -- | Recursively shrink all immediate subterms. @@ -229,7 +238,7 @@ -- | All immediate subterms of a term. -subterms :: (Generic a, Arbitrary a, GSubterms (Rep a) a) => a -> [a] +subterms :: (Generic a, GSubterms (Rep a) a) => a -> [a] subterms = gSubterms . from @@ -292,10 +301,10 @@ gSubtermsIncl (M1 x) = gSubtermsIncl x -- This is the important case: We've found a term of the same type. -instance Arbitrary a => GSubtermsIncl (K1 i a) a where +instance {-# OVERLAPPING #-} GSubtermsIncl (K1 i a) a where gSubtermsIncl (K1 x) = [x] -instance GSubtermsIncl (K1 i a) b where +instance {-# OVERLAPPING #-} GSubtermsIncl (K1 i a) b where gSubtermsIncl (K1 _) = [] #endif @@ -365,7 +374,7 @@ ++ [ x':xs | x' <- shrink x ] -} -instance (Integral a, Arbitrary a) => Arbitrary (Ratio a) where +instance Integral a => Arbitrary (Ratio a) where arbitrary = arbitrarySizedFractional shrink = shrinkRealFracToInteger @@ -494,6 +503,23 @@ arbitrary = arbitrarySizedFractional shrink = shrinkRealFrac +-- Arbitrary instances for container types +instance (Ord a, Arbitrary a) => Arbitrary (Set.Set a) where + arbitrary = fmap Set.fromList arbitrary + shrink = map Set.fromList . shrink . Set.toList +instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where + arbitrary = fmap Map.fromList arbitrary + shrink = map Map.fromList . shrink . Map.toList +instance Arbitrary IntSet.IntSet where + arbitrary = fmap IntSet.fromList arbitrary + shrink = map IntSet.fromList . shrink . IntSet.toList +instance Arbitrary a => Arbitrary (IntMap.IntMap a) where + arbitrary = fmap IntMap.fromList arbitrary + shrink = map IntMap.fromList . shrink . IntMap.toList +instance Arbitrary a => Arbitrary (Sequence.Seq a) where + arbitrary = fmap Sequence.fromList arbitrary + shrink = map Sequence.fromList . shrink . toList + -- ** Helper functions for implementing arbitrary -- | Generates an integral number. The number can be positive or negative @@ -799,6 +825,18 @@ instance CoArbitrary Double where coarbitrary = coarbitraryReal +-- Coarbitrary instances for container types +instance CoArbitrary a => CoArbitrary (Set.Set a) where + coarbitrary = coarbitrary. Set.toList +instance (CoArbitrary k, CoArbitrary v) => CoArbitrary (Map.Map k v) where + coarbitrary = coarbitrary . Map.toList +instance CoArbitrary IntSet.IntSet where + coarbitrary = coarbitrary . IntSet.toList +instance CoArbitrary a => CoArbitrary (IntMap.IntMap a) where + coarbitrary = coarbitrary . IntMap.toList +instance CoArbitrary a => CoArbitrary (Sequence.Seq a) where + coarbitrary = coarbitrary . toList + -- ** Helpers for implementing coarbitrary -- | A 'coarbitrary' implementation for integral numbers. @@ -826,7 +864,7 @@ vector :: Arbitrary a => Int -> Gen [a] vector k = vectorOf k arbitrary --- | Generates an ordered list of a given length. +-- | Generates an ordered list. orderedList :: (Ord a, Arbitrary a) => Gen [a] orderedList = sort `fmap` arbitrary diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.1/Test/QuickCheck/Function.hs new/QuickCheck-2.8.2/Test/QuickCheck/Function.hs --- old/QuickCheck-2.8.1/Test/QuickCheck/Function.hs 2015-04-03 14:23:20.000000000 +0200 +++ new/QuickCheck-2.8.2/Test/QuickCheck/Function.hs 2016-01-15 17:09:16.000000000 +0100 @@ -279,7 +279,7 @@ -- -- > prop :: Fun String Integer -> Bool -- > prop (Fn f) = f "banana" == f "monkey" --- || f "banana" == f "elephant" +-- > || f "banana" == f "elephant" pattern Fn f <- Fun _ f #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.1/Test/QuickCheck/Gen.hs new/QuickCheck-2.8.2/Test/QuickCheck/Gen.hs --- old/QuickCheck-2.8.1/Test/QuickCheck/Gen.hs 2015-04-03 14:23:20.000000000 +0200 +++ new/QuickCheck-2.8.2/Test/QuickCheck/Gen.hs 2016-01-15 17:09:16.000000000 +0100 @@ -33,6 +33,8 @@ ) import Test.QuickCheck.Random +import Data.List +import Data.Ord -------------------------------------------------------------------------- -- ** Generator type @@ -155,13 +157,9 @@ -- | Generates a random permutation of the given list. shuffle :: [a] -> Gen [a] -shuffle [] = return [] shuffle xs = do - (y, ys) <- elements (selectOne xs) - (y:) <$> shuffle ys - where - selectOne [] = [] - selectOne (y:ys) = (y,ys) : map (second (y:)) (selectOne ys) + ns <- vectorOf (length xs) (choose (minBound :: Int, maxBound)) + return (map snd (sortBy (comparing fst) (zip ns xs))) -- | Takes a list of elements of increasing size, and chooses -- among an initial segment of the list. The size of this initial diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.1/Test/QuickCheck/Modifiers.hs new/QuickCheck-2.8.2/Test/QuickCheck/Modifiers.hs --- old/QuickCheck-2.8.1/Test/QuickCheck/Modifiers.hs 2015-04-03 14:23:20.000000000 +0200 +++ new/QuickCheck-2.8.2/Test/QuickCheck/Modifiers.hs 2016-01-15 17:09:16.000000000 +0100 @@ -175,7 +175,7 @@ instance Functor NonZero where fmap f (NonZero x) = NonZero (f x) -instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonZero a) where +instance (Num a, Eq a, Arbitrary a) => Arbitrary (NonZero a) where arbitrary = fmap NonZero $ arbitrary `suchThat` (/= 0) shrink (NonZero x) = [ NonZero x' | x' <- shrink x, x' /= 0 ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.1/Test/QuickCheck/Test.hs new/QuickCheck-2.8.2/Test/QuickCheck/Test.hs --- old/QuickCheck-2.8.1/Test/QuickCheck/Test.hs 2015-04-03 14:23:20.000000000 +0200 +++ new/QuickCheck-2.8.2/Test/QuickCheck/Test.hs 2016-01-15 17:09:16.000000000 +0100 @@ -38,11 +38,20 @@ -- | Args specifies arguments to the QuickCheck driver data Args = Args - { replay :: Maybe (QCGen,Int) -- ^ Should we replay a previous test? - , maxSuccess :: Int -- ^ Maximum number of successful tests before succeeding - , maxDiscardRatio :: Int -- ^ Maximum number of discarded tests per successful test before giving up - , maxSize :: Int -- ^ Size to use for the biggest test cases - , chatty :: Bool -- ^ Whether to print anything + { replay :: Maybe (QCGen,Int) + -- ^ Should we replay a previous test? + -- Note: saving a seed from one version of QuickCheck and + -- replaying it in another is not supported. + -- If you want to store a test case permanently you should save + -- the test case itself. + , maxSuccess :: Int + -- ^ Maximum number of successful tests before succeeding + , maxDiscardRatio :: Int + -- ^ Maximum number of discarded tests per successful test before giving up + , maxSize :: Int + -- ^ Size to use for the biggest test cases + , chatty :: Bool + -- ^ Whether to print anything } deriving ( Show, Read ) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.1/Test/QuickCheck/Text.hs new/QuickCheck-2.8.2/Test/QuickCheck/Text.hs --- old/QuickCheck-2.8.1/Test/QuickCheck/Text.hs 2015-04-03 14:23:20.000000000 +0200 +++ new/QuickCheck-2.8.2/Test/QuickCheck/Text.hs 2016-01-15 17:09:16.000000000 +0100 @@ -35,6 +35,7 @@ , BufferMode (..) , hGetBuffering , hSetBuffering + , hIsTerminalDevice ) import Data.IORef @@ -102,8 +103,10 @@ action `finally` hSetBuffering stderr mode withStdioTerminal :: (Terminal -> IO a) -> IO a -withStdioTerminal action = - withBuffering (newTerminal (handle stdout) (handle stderr) >>= action) +withStdioTerminal action = do + isatty <- hIsTerminalDevice stderr + let err = if isatty then handle stderr else const (return ()) + withBuffering (newTerminal (handle stdout) err >>= action) withNullTerminal :: (Terminal -> IO a) -> IO a withNullTerminal action = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.1/changelog new/QuickCheck-2.8.2/changelog --- old/QuickCheck-2.8.1/changelog 2015-04-03 14:23:20.000000000 +0200 +++ new/QuickCheck-2.8.2/changelog 2016-01-15 17:09:16.000000000 +0100 @@ -1,3 +1,13 @@ +QuickCheck 2.8.2 (released 2016-01-15) + * GHC 8 support + * Add Arbitrary and CoArbitrary instances for types in + containers package + * Improve speed of shuffle combinator + * Only print to stderr if it's a terminal. + * Small changes: slightly improve documentation, + remove redundant constraints from some functions' types, + small improvements to Test.QuickCheck.All. + QuickCheck 2.8.1 (released 2015-04-03) * Fix bug where exceptions thrown printing counterexamples weren't being caught when terminal output was disabled