test-framework-quickcheck 0.2.3 → 0.2.4
raw patch · 2 files changed
+33/−14 lines, 2 filesdep +extensible-exceptionsdep +paralleldep ~base
Dependencies added: extensible-exceptions, parallel
Dependency ranges changed: base
Files
Test/Framework/Providers/QuickCheck.hs view
@@ -9,6 +9,9 @@ import Test.QuickCheck hiding (Property) +import qualified Control.Exception.Extensible as E+import Control.Parallel.Strategies (rnf)+ import Data.List import System.Random@@ -37,6 +40,7 @@ | PropertyArgumentsExhausted -- ^ The property may be true, but we ran out of arguments to try it out on | PropertyFalsifiable [String] -- ^ The property was not true. The list of strings are the arguments inducing failure. | PropertyTimedOut -- ^ The property timed out during execution+ | PropertyException String -- ^ The property raised an exception during execution instance Show PropertyResult where show (PropertyResult { pr_status = status, pr_used_seed = used_seed, pr_tests_run = mb_tests_run })@@ -45,6 +49,7 @@ PropertyArgumentsExhausted -> "Arguments exhausted after " ++ tests_run_str ++ " tests" PropertyFalsifiable test_args -> "Falsifiable with seed " ++ show used_seed ++ ", after " ++ tests_run_str ++ " tests:\n" ++ unlinesConcise test_args PropertyTimedOut -> "Timed out after " ++ tests_run_str ++ " tests"+ PropertyException text -> "Got an exception: " ++ text where tests_run_str = fmap show mb_tests_run `orElse` "an unknown number of" @@ -87,13 +92,22 @@ | nfail == unK (topt_maximum_unsuitable_generated_tests topts) = do return (PropertyArgumentsExhausted, ntest) | otherwise = do yieldImprovement ntest- case ok result of- Nothing ->- myTests topts gen rnd1 ntest (nfail + 1) stamps- Just True ->- myTests topts gen rnd1 (ntest + 1) nfail (stamp result:stamps)- Just False ->- return (PropertyFalsifiable (arguments result), ntest)+ -- Rather clunky code that tries to catch exceptions early. If we don't do this then errors+ -- in your properties just kill the test framework - very bad!+ mb_exception <- liftIO $ E.catch (fmap (const Nothing) $ E.evaluate (rnfResult result))+ (return . Just . show :: E.SomeException -> IO (Maybe String))+ case mb_exception of+ Just e -> return (PropertyException e, ntest)+ Nothing -> case ok result of+ Nothing ->+ myTests topts gen rnd1 ntest (nfail + 1) stamps+ Just True ->+ myTests topts gen rnd1 (ntest + 1) nfail (stamp result:stamps)+ Just False ->+ return (PropertyFalsifiable (arguments result), ntest) where result = generate (configSize defaultConfig ntest) rnd2 gen (rnd1, rnd2) = split rnd0+ + -- Reduce a Result to RNF before we poke at it in order to uncover hidden exceptions+ rnfResult r = rnf (ok r) `seq` rnf (stamp r) `seq` rnf (arguments r)
test-framework-quickcheck.cabal view
@@ -1,5 +1,5 @@ Name: test-framework-quickcheck-Version: 0.2.3+Version: 0.2.4 Cabal-Version: >= 1.2.3 Category: Testing Synopsis: QuickCheck support for the test-framework package.@@ -10,19 +10,24 @@ Homepage: http://batterseapower.github.com/test-framework/ Build-Type: Simple -Flag SplitBase- Description: Choose the new smaller, split-up base package+Flag Base4+ Description: Choose base version 4 Default: True +Flag Base3+ Description: Choose base version 3+ Default: False + Library Exposed-Modules: Test.Framework.Providers.QuickCheck - Build-Depends: test-framework >= 0.2.0, QuickCheck >= 1.1 && < 2- if flag(splitBase)- Build-Depends: base >= 3 && < 5, random >= 1+ Build-Depends: test-framework >= 0.2.0, QuickCheck >= 1.1 && < 2, extensible-exceptions >= 0.1.1+ if flag(base3)+ Build-Depends: base >= 3 && < 4, random >= 1, parallel >= 1 else- Build-Depends: base < 3+ if flag(base4)+ Build-Depends: base >= 4 && < 5, random >= 1, parallel >= 1 Extensions: TypeSynonymInstances TypeOperators