test-framework-quickcheck (empty) → 0.2.0

raw patch · 5 files changed

+158/−0 lines, 5 filesdep +QuickCheckdep +basedep +randomsetup-changed

Dependencies added: QuickCheck, base, random, test-framework

Files

• LICENSE +22/−0
• README.textile +3/−0
• Setup.lhs +4/−0
• Test/Framework/Providers/QuickCheck.hs +96/−0
• test-framework-quickcheck.cabal +33/−0

@@ -0,0 +1,22 @@+Copyright (c) 2008, Maximilian Bolingbroke+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted+provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright notice, this list of+      conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice, this list of+      conditions and the following disclaimer in the documentation and/or other materials+      provided with the distribution.+    * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to+      endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER+IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT+OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,3 @@+h1. Test Framework QuickCheck Support++For more information, please see the latest version of the test-framework package README. This can be found at the "GitHub wiki":http://github.com/batterseapower/test-framework/wikis/readme.

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,96 @@+module Test.Framework.Providers.QuickCheck (+        testProperty+    ) where++import Test.Framework.Providers.API++import Test.QuickCheck hiding (Property)++import Data.List++import System.Random+++-- | Create a 'Test' for a QuickCheck 'Testable' property+testProperty :: Testable a => TestName -> a -> Test+testProperty name = Test name . Property+++instance TestResultlike PropertyTestCount PropertyResult where+    testSucceeded = propertySucceeded++-- | Used to document numbers which we expect to be intermediate test counts from running properties+type PropertyTestCount = Int++-- | The failure information from the run of a property+data PropertyResult = PropertyResult {+        pr_status :: PropertyStatus,+        pr_used_seed :: Int,+        pr_tests_run :: Maybe PropertyTestCount -- Due to technical limitations, it's currently not possible to find out the number of+                                                -- tests previously run if the test times out, hence we need a Maybe here for that case.+    }++data PropertyStatus = PropertyOK                   -- ^ The property is true as far as we could check it+                    | 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++instance Show PropertyResult where+    show (PropertyResult { pr_status = status, pr_used_seed = used_seed, pr_tests_run = mb_tests_run })+      = case status of+            PropertyOK                    -> "OK, passed " ++ tests_run_str ++ " tests"+            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"+      where+        tests_run_str = fmap show mb_tests_run `orElse` "an unknown number of"++propertySucceeded :: PropertyResult -> Bool+propertySucceeded result = propertyStatusIsSuccess (pr_status result)++propertyStatusIsSuccess :: PropertyStatus -> Bool+propertyStatusIsSuccess PropertyOK                 = True+propertyStatusIsSuccess PropertyArgumentsExhausted = True+propertyStatusIsSuccess _                          = False+++data Property = forall a. Testable a => Property a++instance Testlike PropertyTestCount PropertyResult Property where+    runTest topts (Property testable) = runProperty topts testable+    testTypeName _ = "Properties"++runProperty :: Testable a => CompleteTestOptions -> a -> IO (PropertyTestCount :~> PropertyResult, IO ())+runProperty topts testable = do+    (gen, seed) <- newSeededStdGen (unK $ topt_seed topts)+    runImprovingIO $ do+        mb_result <- maybeTimeoutImprovingIO (unK (topt_timeout topts)) $ myCheck topts gen testable+        return $ toPropertyResult seed $ case mb_result of+            Nothing                  -> (PropertyTimedOut, Nothing)+            Just (status, tests_run) -> (status, Just tests_run)+  where+    toPropertyResult seed (status, mb_tests_run) = PropertyResult {+            pr_status = status,+            pr_used_seed = seed,+            pr_tests_run = mb_tests_run+        }++myCheck :: (Testable a) => CompleteTestOptions -> StdGen -> a -> ImprovingIO PropertyTestCount f (PropertyStatus, PropertyTestCount)+myCheck topts rnd a = myTests topts (evaluate a) rnd 0 0 []++myTests :: CompleteTestOptions -> Gen Result -> StdGen -> PropertyTestCount -> PropertyTestCount -> [[String]] -> ImprovingIO PropertyTestCount f (PropertyStatus, PropertyTestCount)+myTests topts gen rnd0 ntest nfail stamps+  | ntest == unK (topt_maximum_generated_tests topts)            = do return (PropertyOK, ntest)+  | 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)+  where+    result       = generate (configSize defaultConfig ntest) rnd2 gen+    (rnd1, rnd2) = split rnd0

@@ -0,0 +1,33 @@+Name:                test-framework-quickcheck+Version:             0.2.0+Cabal-Version:       >= 1.2+Category:            Testing+Synopsis:            QuickCheck support for the test-framework package.+License:             BSD3+License-File:        LICENSE+Extra-Source-Files:  README.textile+Author:              Max Bolingbroke+Maintainer:          batterseapower@hotmail.com+Homepage:            http://github.com/batterseapower/test-framework+Build-Type:          Simple++Flag SplitBase+        Description:    Choose the new smaller, split-up base package+        Default:        True+++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, random >= 1+        else+                Build-Depends:          base < 3+        +        Extensions:             TypeSynonymInstances+                                TypeOperators+                                MultiParamTypeClasses+                                ExistentialQuantification+        +        Ghc-Options:            -Wall