From 1bad5f437fb14922737e448fa0dd03554e12e57a Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 21 Mar 2024 15:56:29 +0100 Subject: [PATCH 1/5] Add `withCounterexample` to get a re-useable handle on counterexamples + add recheck to quickly re-test a property --- src/Test/QuickCheck.hs | 11 +++++++++ src/Test/QuickCheck/Property.hs | 42 +++++++++++++++++++++++++++++++-- src/Test/QuickCheck/Test.hs | 29 +++++++++++++++++++++++ 3 files changed, 80 insertions(+), 2 deletions(-) diff --git a/src/Test/QuickCheck.hs b/src/Test/QuickCheck.hs index 12fb6822..d9fb61ae 100644 --- a/src/Test/QuickCheck.hs +++ b/src/Test/QuickCheck.hs @@ -78,6 +78,11 @@ module Test.QuickCheck , quickCheckWith , quickCheckWithResult , quickCheckResult +#ifndef NO_TYPEABLE + , quickCheckCounterexample + , quickCheckWithCounterexample +#endif + , recheck , isSuccess -- ** Running tests verbosely , verboseCheck @@ -317,6 +322,12 @@ module Test.QuickCheck , (.||.) , disjoin -- ** What to do on failure +#ifndef NO_TYPEABLE + , Counterexample(..) + , withCounterexample + , coerceCounterexample + , castCounterexample +#endif , counterexample , printTestCase , whenFail diff --git a/src/Test/QuickCheck/Property.hs b/src/Test/QuickCheck/Property.hs index f8ab6744..4a4b1ad1 100644 --- a/src/Test/QuickCheck/Property.hs +++ b/src/Test/QuickCheck/Property.hs @@ -3,6 +3,7 @@ {-# LANGUAGE CPP #-} #ifndef NO_TYPEABLE {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ExistentialQuantification #-} #endif #ifndef NO_SAFE_HASKELL {-# LANGUAGE Safe #-} @@ -33,7 +34,7 @@ import Data.Set(Set) import Control.DeepSeq #endif #ifndef NO_TYPEABLE -import Data.Typeable (Typeable) +import Data.Typeable (Typeable, cast) #endif import Data.Maybe @@ -254,6 +255,32 @@ data Callback data CallbackKind = Counterexample -- ^ Affected by the 'verbose' combinator | NotCounterexample -- ^ Not affected by the 'verbose' combinator +#ifndef NO_TYPEABLE +data Counterexample = forall a. (Typeable a, Show a) => Cex a + +instance Show Counterexample where + show (Cex a) = show a + +coerceCounterexample :: Typeable a => Counterexample -> a +coerceCounterexample (Cex a) = case cast a of + Nothing -> error $ "Can't coerceCounterexample " ++ show a + Just a -> a + +castCounterexample :: Typeable a => Counterexample -> Maybe a +castCounterexample (Cex a) = cast a + +data Counterexamples = NoCounterexamples + | forall a. (Typeable a, Show a) => a :! Counterexamples + +toCounterexamples :: [Counterexample] -> Counterexamples +toCounterexamples [] = NoCounterexamples +toCounterexamples (Cex a : ces) = a :! toCounterexamples ces + +#define COUNTEREXAMPLES(a) , theCounterexamples a +#else +#define COUNTEREXAMPLES(a) +#endif + -- | The result of a single test. data Result = MkResult @@ -289,6 +316,7 @@ data Result -- ^ the callbacks for this test case , testCase :: [String] -- ^ the generated test case + COUNTEREXAMPLES(:: [Counterexample]) } exception :: String -> AnException -> Result @@ -329,6 +357,7 @@ succeeded, failed, rejected :: Result , requiredCoverage = [] , callbacks = [] , testCase = [] + COUNTEREXAMPLES(= []) } -------------------------------------------------------------------------- @@ -502,6 +531,13 @@ withMaxShrinks n = n `seq` mapTotalResult (\res -> res{ maybeMaxShrinks = Just n withMaxSize :: Testable prop => Int -> prop -> Property withMaxSize n = n `seq` mapTotalResult (\res -> res{ maybeMaxTestSize = Just n }) +#ifndef NO_TYPEABLE +-- | Return a value in the 'counterexamples' field of the 'Result' returned by 'quickCheckResult'. Counterexamples +-- are returned outer-most first. +withCounterexample :: (Typeable a, Show a, Testable prop) => a -> prop -> Property +withCounterexample a = a `seq` mapTotalResult (\res -> res{ theCounterexamples = Cex a : theCounterexamples res }) +#endif + -- | Check that all coverage requirements defined by 'cover' and 'coverTable' -- are met, using a statistically sound test, and fail if they are not met. -- @@ -963,7 +999,9 @@ disjoin ps = callbacks result2, testCase = testCase result1 ++ - testCase result2 } + testCase result2 + COUNTEREXAMPLES(= theCounterexamples result1 ++ theCounterexamples result2) + } Nothing -> result2 -- The "obvious" semantics of .||. has: -- discard .||. true = true diff --git a/src/Test/QuickCheck/Test.hs b/src/Test/QuickCheck/Test.hs index 64000a55..1034eb65 100644 --- a/src/Test/QuickCheck/Test.hs +++ b/src/Test/QuickCheck/Test.hs @@ -144,6 +144,10 @@ data Result -- ^ The test case's labels (see 'label') , failingClasses :: Set String -- ^ The test case's classes (see 'classify') +#ifndef NO_TYPEABLE + , counterexamples :: [Counterexample] + -- ^ The existentially quantified counterexamples provided by 'withCounterexample' +#endif } -- | A property that should have failed did not | NoExpectedFailure @@ -199,6 +203,28 @@ quickCheckWithResult :: Testable prop => Args -> prop -> IO Result quickCheckWithResult a p = withState a (\s -> test s (property p)) +#ifndef NO_TYPEABLE +-- | Test a property and get counterexamples as a result. Can be used like: +-- +-- @ +-- $> x :! _ <- quickCheckCounterexample $ \ x -> withCounterexample (x :: Int) (x > 0) +-- *** Failed! Falsified (after 1 test): +-- 0 +-- $> x +-- 0 +quickCheckCounterexample :: Testable prop => prop -> IO Counterexamples +quickCheckCounterexample = quickCheckWithCounterexample stdArgs + +-- | Test a property, using test arguments, and get counterexamples as a result. +quickCheckWithCounterexample :: Testable prop => Args -> prop -> IO Counterexamples +quickCheckWithCounterexample args p = toCounterexamples . counterexamples <$> quickCheckWithResult args p +#endif + +-- | Re-run a property with the seed and size that failed in a run of 'quickCheckResult'. +recheck :: Testable prop => Result -> prop -> IO () +recheck res@Failure{} = quickCheckWith stdArgs{ replay = Just (usedSeed res, usedSize res)} . once +recheck _ = error "Can only recheck tests that failed with a counterexample." + withState :: Args -> (State -> IO a) -> IO a withState a test = (if chatty a then withStdioTerminal else withNullTerminal) $ \tm -> do rnd <- case replay a of @@ -481,6 +507,9 @@ runATest st prop = , failingTestCase = testCase , failingLabels = P.labels res , failingClasses = Set.fromList (map fst $ filter snd $ P.classes res) +#ifndef NO_TYPEABLE + , counterexamples = theCounterexamples res +#endif } where (rnd1,rnd2) = split (randomSeed st) From b084a08dfa6ddf1405d2e55f919d0a569963e7b4 Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 4 Apr 2024 10:41:37 +0200 Subject: [PATCH 2/5] Counterexample -> Witness --- src/Test/QuickCheck.hs | 12 +++++----- src/Test/QuickCheck/Property.hs | 40 ++++++++++++++++----------------- src/Test/QuickCheck/Test.hs | 16 ++++++------- 3 files changed, 34 insertions(+), 34 deletions(-) diff --git a/src/Test/QuickCheck.hs b/src/Test/QuickCheck.hs index d9fb61ae..1782d654 100644 --- a/src/Test/QuickCheck.hs +++ b/src/Test/QuickCheck.hs @@ -79,8 +79,8 @@ module Test.QuickCheck , quickCheckWithResult , quickCheckResult #ifndef NO_TYPEABLE - , quickCheckCounterexample - , quickCheckWithCounterexample + , quickCheckWitness + , quickCheckWithWitness #endif , recheck , isSuccess @@ -323,10 +323,10 @@ module Test.QuickCheck , disjoin -- ** What to do on failure #ifndef NO_TYPEABLE - , Counterexample(..) - , withCounterexample - , coerceCounterexample - , castCounterexample + , Witness(..) + , withWitness + , coerceWitness + , castWitness #endif , counterexample , printTestCase diff --git a/src/Test/QuickCheck/Property.hs b/src/Test/QuickCheck/Property.hs index 4a4b1ad1..14699163 100644 --- a/src/Test/QuickCheck/Property.hs +++ b/src/Test/QuickCheck/Property.hs @@ -256,29 +256,29 @@ data CallbackKind = Counterexample -- ^ Affected by the 'verbose' combinator | NotCounterexample -- ^ Not affected by the 'verbose' combinator #ifndef NO_TYPEABLE -data Counterexample = forall a. (Typeable a, Show a) => Cex a +data Witness = forall a. (Typeable a, Show a) => Cex a -instance Show Counterexample where +instance Show Witness where show (Cex a) = show a -coerceCounterexample :: Typeable a => Counterexample -> a -coerceCounterexample (Cex a) = case cast a of - Nothing -> error $ "Can't coerceCounterexample " ++ show a +coerceWitness :: Typeable a => Witness -> a +coerceWitness (Cex a) = case cast a of + Nothing -> error $ "Can't coerceWitness " ++ show a Just a -> a -castCounterexample :: Typeable a => Counterexample -> Maybe a -castCounterexample (Cex a) = cast a +castWitness :: Typeable a => Witness -> Maybe a +castWitness (Cex a) = cast a -data Counterexamples = NoCounterexamples - | forall a. (Typeable a, Show a) => a :! Counterexamples +data Witnesses = NoWitnesses + | forall a. (Typeable a, Show a) => a :! Witnesses -toCounterexamples :: [Counterexample] -> Counterexamples -toCounterexamples [] = NoCounterexamples -toCounterexamples (Cex a : ces) = a :! toCounterexamples ces +toWitnesses :: [Witness] -> Witnesses +toWitnesses [] = NoWitnesses +toWitnesses (Cex a : ces) = a :! toWitnesses ces -#define COUNTEREXAMPLES(a) , theCounterexamples a +#define WITNESSES(a) , theWitnesses a #else -#define COUNTEREXAMPLES(a) +#define WITNESSES(a) #endif -- | The result of a single test. @@ -316,7 +316,7 @@ data Result -- ^ the callbacks for this test case , testCase :: [String] -- ^ the generated test case - COUNTEREXAMPLES(:: [Counterexample]) + WITNESSES(:: [Witness]) } exception :: String -> AnException -> Result @@ -357,7 +357,7 @@ succeeded, failed, rejected :: Result , requiredCoverage = [] , callbacks = [] , testCase = [] - COUNTEREXAMPLES(= []) + WITNESSES(= []) } -------------------------------------------------------------------------- @@ -532,10 +532,10 @@ withMaxSize :: Testable prop => Int -> prop -> Property withMaxSize n = n `seq` mapTotalResult (\res -> res{ maybeMaxTestSize = Just n }) #ifndef NO_TYPEABLE --- | Return a value in the 'counterexamples' field of the 'Result' returned by 'quickCheckResult'. Counterexamples +-- | Return a value in the 'counterexamples' field of the 'Result' returned by 'quickCheckResult'. Witnesses -- are returned outer-most first. -withCounterexample :: (Typeable a, Show a, Testable prop) => a -> prop -> Property -withCounterexample a = a `seq` mapTotalResult (\res -> res{ theCounterexamples = Cex a : theCounterexamples res }) +withWitness :: (Typeable a, Show a, Testable prop) => a -> prop -> Property +withWitness a = a `seq` mapTotalResult (\res -> res{ theWitnesses = Cex a : theWitnesses res }) #endif -- | Check that all coverage requirements defined by 'cover' and 'coverTable' @@ -1000,7 +1000,7 @@ disjoin ps = testCase = testCase result1 ++ testCase result2 - COUNTEREXAMPLES(= theCounterexamples result1 ++ theCounterexamples result2) + WITNESSES(= theWitnesses result1 ++ theWitnesses result2) } Nothing -> result2 -- The "obvious" semantics of .||. has: diff --git a/src/Test/QuickCheck/Test.hs b/src/Test/QuickCheck/Test.hs index 1034eb65..ed90784b 100644 --- a/src/Test/QuickCheck/Test.hs +++ b/src/Test/QuickCheck/Test.hs @@ -145,8 +145,8 @@ data Result , failingClasses :: Set String -- ^ The test case's classes (see 'classify') #ifndef NO_TYPEABLE - , counterexamples :: [Counterexample] - -- ^ The existentially quantified counterexamples provided by 'withCounterexample' + , counterexamples :: [Witness] + -- ^ The existentially quantified counterexamples provided by 'withWitness' #endif } -- | A property that should have failed did not @@ -207,17 +207,17 @@ quickCheckWithResult a p = -- | Test a property and get counterexamples as a result. Can be used like: -- -- @ --- $> x :! _ <- quickCheckCounterexample $ \ x -> withCounterexample (x :: Int) (x > 0) +-- $> x :! _ <- quickCheckWitness $ \ x -> withWitness (x :: Int) (x > 0) -- *** Failed! Falsified (after 1 test): -- 0 -- $> x -- 0 -quickCheckCounterexample :: Testable prop => prop -> IO Counterexamples -quickCheckCounterexample = quickCheckWithCounterexample stdArgs +quickCheckWitness :: Testable prop => prop -> IO Witnesses +quickCheckWitness = quickCheckWithWitness stdArgs -- | Test a property, using test arguments, and get counterexamples as a result. -quickCheckWithCounterexample :: Testable prop => Args -> prop -> IO Counterexamples -quickCheckWithCounterexample args p = toCounterexamples . counterexamples <$> quickCheckWithResult args p +quickCheckWithWitness :: Testable prop => Args -> prop -> IO Witnesses +quickCheckWithWitness args p = toWitnesses . counterexamples <$> quickCheckWithResult args p #endif -- | Re-run a property with the seed and size that failed in a run of 'quickCheckResult'. @@ -508,7 +508,7 @@ runATest st prop = , failingLabels = P.labels res , failingClasses = Set.fromList (map fst $ filter snd $ P.classes res) #ifndef NO_TYPEABLE - , counterexamples = theCounterexamples res + , counterexamples = theWitnesses res #endif } where From 144b64b6c9c1ae3944b68282eeda1f4c99a42638 Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 4 Apr 2024 10:44:02 +0200 Subject: [PATCH 3/5] wip --- src/Test/QuickCheck.hs | 4 ++-- src/Test/QuickCheck/Property.hs | 2 +- src/Test/QuickCheck/Test.hs | 20 ++++++++++---------- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/Test/QuickCheck.hs b/src/Test/QuickCheck.hs index 1782d654..e79499c6 100644 --- a/src/Test/QuickCheck.hs +++ b/src/Test/QuickCheck.hs @@ -79,8 +79,8 @@ module Test.QuickCheck , quickCheckWithResult , quickCheckResult #ifndef NO_TYPEABLE - , quickCheckWitness - , quickCheckWithWitness + , quickCheckWitnesses + , quickCheckWithWitnesses #endif , recheck , isSuccess diff --git a/src/Test/QuickCheck/Property.hs b/src/Test/QuickCheck/Property.hs index 14699163..a6947b65 100644 --- a/src/Test/QuickCheck/Property.hs +++ b/src/Test/QuickCheck/Property.hs @@ -532,7 +532,7 @@ withMaxSize :: Testable prop => Int -> prop -> Property withMaxSize n = n `seq` mapTotalResult (\res -> res{ maybeMaxTestSize = Just n }) #ifndef NO_TYPEABLE --- | Return a value in the 'counterexamples' field of the 'Result' returned by 'quickCheckResult'. Witnesses +-- | Return a value in the 'witnesses' field of the 'Result' returned by 'quickCheckResult'. Witnesses -- are returned outer-most first. withWitness :: (Typeable a, Show a, Testable prop) => a -> prop -> Property withWitness a = a `seq` mapTotalResult (\res -> res{ theWitnesses = Cex a : theWitnesses res }) diff --git a/src/Test/QuickCheck/Test.hs b/src/Test/QuickCheck/Test.hs index ed90784b..e45d1e05 100644 --- a/src/Test/QuickCheck/Test.hs +++ b/src/Test/QuickCheck/Test.hs @@ -145,8 +145,8 @@ data Result , failingClasses :: Set String -- ^ The test case's classes (see 'classify') #ifndef NO_TYPEABLE - , counterexamples :: [Witness] - -- ^ The existentially quantified counterexamples provided by 'withWitness' + , witnesses :: [Witness] + -- ^ The existentially quantified witnesses provided by 'withWitness' #endif } -- | A property that should have failed did not @@ -204,20 +204,20 @@ quickCheckWithResult a p = withState a (\s -> test s (property p)) #ifndef NO_TYPEABLE --- | Test a property and get counterexamples as a result. Can be used like: +-- | Test a property and get witnesses as a result. Can be used like: -- -- @ --- $> x :! _ <- quickCheckWitness $ \ x -> withWitness (x :: Int) (x > 0) +-- $> x :! _ <- quickCheckWitnesses $ \ x -> withWitness (x :: Int) (x > 0) -- *** Failed! Falsified (after 1 test): -- 0 -- $> x -- 0 -quickCheckWitness :: Testable prop => prop -> IO Witnesses -quickCheckWitness = quickCheckWithWitness stdArgs +quickCheckWitnesses :: Testable prop => prop -> IO Witnesses +quickCheckWitnesses = quickCheckWithWitnesses stdArgs --- | Test a property, using test arguments, and get counterexamples as a result. -quickCheckWithWitness :: Testable prop => Args -> prop -> IO Witnesses -quickCheckWithWitness args p = toWitnesses . counterexamples <$> quickCheckWithResult args p +-- | Test a property, using test arguments, and get witnesses as a result. +quickCheckWithWitnesses :: Testable prop => Args -> prop -> IO Witnesses +quickCheckWithWitnesses args p = toWitnesses . witnesses <$> quickCheckWithResult args p #endif -- | Re-run a property with the seed and size that failed in a run of 'quickCheckResult'. @@ -508,7 +508,7 @@ runATest st prop = , failingLabels = P.labels res , failingClasses = Set.fromList (map fst $ filter snd $ P.classes res) #ifndef NO_TYPEABLE - , counterexamples = theWitnesses res + , witnesses = theWitnesses res #endif } where From 8a61a7870df6ac07a121df9d71871c15e09ced57 Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 18 Apr 2024 09:31:14 +0200 Subject: [PATCH 4/5] rename withWitness to witness and rename Cex to Wit --- src/Test/QuickCheck.hs | 2 +- src/Test/QuickCheck/Property.hs | 14 +++++++------- src/Test/QuickCheck/Test.hs | 4 ++-- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Test/QuickCheck.hs b/src/Test/QuickCheck.hs index e79499c6..1ea6e881 100644 --- a/src/Test/QuickCheck.hs +++ b/src/Test/QuickCheck.hs @@ -324,7 +324,7 @@ module Test.QuickCheck -- ** What to do on failure #ifndef NO_TYPEABLE , Witness(..) - , withWitness + , witness , coerceWitness , castWitness #endif diff --git a/src/Test/QuickCheck/Property.hs b/src/Test/QuickCheck/Property.hs index a6947b65..354514af 100644 --- a/src/Test/QuickCheck/Property.hs +++ b/src/Test/QuickCheck/Property.hs @@ -256,25 +256,25 @@ data CallbackKind = Counterexample -- ^ Affected by the 'verbose' combinator | NotCounterexample -- ^ Not affected by the 'verbose' combinator #ifndef NO_TYPEABLE -data Witness = forall a. (Typeable a, Show a) => Cex a +data Witness = forall a. (Typeable a, Show a) => Wit a instance Show Witness where - show (Cex a) = show a + show (Wit a) = show a coerceWitness :: Typeable a => Witness -> a -coerceWitness (Cex a) = case cast a of +coerceWitness (Wit a) = case cast a of Nothing -> error $ "Can't coerceWitness " ++ show a Just a -> a castWitness :: Typeable a => Witness -> Maybe a -castWitness (Cex a) = cast a +castWitness (Wit a) = cast a data Witnesses = NoWitnesses | forall a. (Typeable a, Show a) => a :! Witnesses toWitnesses :: [Witness] -> Witnesses toWitnesses [] = NoWitnesses -toWitnesses (Cex a : ces) = a :! toWitnesses ces +toWitnesses (Wit a : ces) = a :! toWitnesses ces #define WITNESSES(a) , theWitnesses a #else @@ -534,8 +534,8 @@ withMaxSize n = n `seq` mapTotalResult (\res -> res{ maybeMaxTestSize = Just n } #ifndef NO_TYPEABLE -- | Return a value in the 'witnesses' field of the 'Result' returned by 'quickCheckResult'. Witnesses -- are returned outer-most first. -withWitness :: (Typeable a, Show a, Testable prop) => a -> prop -> Property -withWitness a = a `seq` mapTotalResult (\res -> res{ theWitnesses = Cex a : theWitnesses res }) +witness :: (Typeable a, Show a, Testable prop) => a -> prop -> Property +witness a = a `seq` mapTotalResult (\res -> res{ theWitnesses = Wit a : theWitnesses res }) #endif -- | Check that all coverage requirements defined by 'cover' and 'coverTable' diff --git a/src/Test/QuickCheck/Test.hs b/src/Test/QuickCheck/Test.hs index e45d1e05..aa238726 100644 --- a/src/Test/QuickCheck/Test.hs +++ b/src/Test/QuickCheck/Test.hs @@ -146,7 +146,7 @@ data Result -- ^ The test case's classes (see 'classify') #ifndef NO_TYPEABLE , witnesses :: [Witness] - -- ^ The existentially quantified witnesses provided by 'withWitness' + -- ^ The existentially quantified witnesses provided by 'witness' #endif } -- | A property that should have failed did not @@ -207,7 +207,7 @@ quickCheckWithResult a p = -- | Test a property and get witnesses as a result. Can be used like: -- -- @ --- $> x :! _ <- quickCheckWitnesses $ \ x -> withWitness (x :: Int) (x > 0) +-- $> x :! _ <- quickCheckWitnesses $ \ x -> witness (x :: Int) (x > 0) -- *** Failed! Falsified (after 1 test): -- 0 -- $> x From 2336786016030ed01d4b2377e0c8ac97921fbd4a Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 18 Apr 2024 09:42:43 +0200 Subject: [PATCH 5/5] react to comments --- src/Test/QuickCheck.hs | 4 ---- src/Test/QuickCheck/Property.hs | 17 ++++++++++------- src/Test/QuickCheck/Test.hs | 17 ----------------- 3 files changed, 10 insertions(+), 28 deletions(-) diff --git a/src/Test/QuickCheck.hs b/src/Test/QuickCheck.hs index 1ea6e881..78cbaa1e 100644 --- a/src/Test/QuickCheck.hs +++ b/src/Test/QuickCheck.hs @@ -78,10 +78,6 @@ module Test.QuickCheck , quickCheckWith , quickCheckWithResult , quickCheckResult -#ifndef NO_TYPEABLE - , quickCheckWitnesses - , quickCheckWithWitnesses -#endif , recheck , isSuccess -- ** Running tests verbosely diff --git a/src/Test/QuickCheck/Property.hs b/src/Test/QuickCheck/Property.hs index 354514af..c00f36d5 100644 --- a/src/Test/QuickCheck/Property.hs +++ b/src/Test/QuickCheck/Property.hs @@ -269,13 +269,6 @@ coerceWitness (Wit a) = case cast a of castWitness :: Typeable a => Witness -> Maybe a castWitness (Wit a) = cast a -data Witnesses = NoWitnesses - | forall a. (Typeable a, Show a) => a :! Witnesses - -toWitnesses :: [Witness] -> Witnesses -toWitnesses [] = NoWitnesses -toWitnesses (Wit a : ces) = a :! toWitnesses ces - #define WITNESSES(a) , theWitnesses a #else #define WITNESSES(a) @@ -534,6 +527,16 @@ withMaxSize n = n `seq` mapTotalResult (\res -> res{ maybeMaxTestSize = Just n } #ifndef NO_TYPEABLE -- | Return a value in the 'witnesses' field of the 'Result' returned by 'quickCheckResult'. Witnesses -- are returned outer-most first. +-- +-- In ghci, for example: +-- +-- >>> [Wit x] <- fmap witnesses . quickCheckResult $ \ x -> witness x $ x == (0 :: Int) +-- *** Failed! Falsified (after 2 tests): +-- 1 +-- >>> x +-- 1 +-- >>> :t x +-- x :: Int witness :: (Typeable a, Show a, Testable prop) => a -> prop -> Property witness a = a `seq` mapTotalResult (\res -> res{ theWitnesses = Wit a : theWitnesses res }) #endif diff --git a/src/Test/QuickCheck/Test.hs b/src/Test/QuickCheck/Test.hs index aa238726..7d7c28f9 100644 --- a/src/Test/QuickCheck/Test.hs +++ b/src/Test/QuickCheck/Test.hs @@ -203,23 +203,6 @@ quickCheckWithResult :: Testable prop => Args -> prop -> IO Result quickCheckWithResult a p = withState a (\s -> test s (property p)) -#ifndef NO_TYPEABLE --- | Test a property and get witnesses as a result. Can be used like: --- --- @ --- $> x :! _ <- quickCheckWitnesses $ \ x -> witness (x :: Int) (x > 0) --- *** Failed! Falsified (after 1 test): --- 0 --- $> x --- 0 -quickCheckWitnesses :: Testable prop => prop -> IO Witnesses -quickCheckWitnesses = quickCheckWithWitnesses stdArgs - --- | Test a property, using test arguments, and get witnesses as a result. -quickCheckWithWitnesses :: Testable prop => Args -> prop -> IO Witnesses -quickCheckWithWitnesses args p = toWitnesses . witnesses <$> quickCheckWithResult args p -#endif - -- | Re-run a property with the seed and size that failed in a run of 'quickCheckResult'. recheck :: Testable prop => Result -> prop -> IO () recheck res@Failure{} = quickCheckWith stdArgs{ replay = Just (usedSeed res, usedSize res)} . once