pqc 0.2 → 0.3
raw patch · 4 files changed
+105/−207 lines, 4 filesdep ~QuickCheckdep ~basenew-uploader
Dependency ranges changed: QuickCheck, base
Files
- README +0/−79
- Test/QuickCheck/Parallel.hs +94/−70
- examples/Example.hs +0/−52
- pqc.cabal +11/−6
− README
@@ -1,79 +0,0 @@--------------------------------------------------------------------------PQC: QuickCheck in the Age of Concurrency--An SMP parallel QuickCheck driver---------------------------------------------------------------------------Quick start:---------------------------------------------------------------------------Parallel batch driver for QuickCheck--Run your properties in chunks over multiple cpus.--Building (usual Cabal instructions):-- $ runhaskell Setup.lhs configure - $ runhaskell Setup.lhs build- $ runhaskell Setup.lhs install--Example use in: examples/Example.hs---------------------------------------------------------------------------Long story---------------------------------------------------------------------------Do you:-- * Have (or want) lots of QuickCheck properties? - * Run them often (maybe on every darcs commit)? - * Tired of waiting for the testsuite to finish? - * Got a multi-core box with cpus sitting idle...? - -Yes? You need Parallel QuickCheck! --PQC provides a single module: Test.QuickCheck.Parallel. This is a-QuickCheck driver that runs property lists as jobs in parallel, and will-utilise as many cores as you wish, with the SMP parallel GHC 6.6-runtime. It is simple, scalable replacement for Test.QuickCheck.Batch.--An example, on a 4 cpu linux server, running 20 quickcheck properties.-- With 1 thread only:- $ time ./a.out 1- 1: sort1 : OK, 1000 tests.- 1: sort2 : OK, 1000 tests.- 1: sort3 : OK, 1000 tests.- 1: sort4 : OK, 1000 tests.- ...- ./a.out 1 > x 18.94s user 0.01s system 99% cpu 18.963 total-- 18 seconds, 99% cpu. But I've got another 3 2.80GHz processors sitting- idle! Let's use them, to run the testsuite faster. No recompilation required.-- 4 OS threads, 4 Haskell threads:- $ time ./a.out 4 +RTS -N4 > /dev/null- ./a.out 4 +RTS -N4 > /dev/null 20.65s user 0.22s system 283% cpu 7.349 total-- 283% cpu, not bad. We're getting close to being limited by the- length of the longest running test.--Or on a dual core macbook, thanks to Spencer Janssen for macbook data-and testing:-- 1 thread:- ./Example 1 - 17.256s-- 2 thread:- ./Example 2 +RTS -N2 - 10.402s--Get it!-- Homepage: http://www.cse.unsw.edu.au/~dons/pqc.html- Haddocks: http://www.cse.unsw.edu.au/~dons/pqc/- Example : http://www.cse.unsw.edu.au/~dons/code/pqc/examples/Example.hs-- darcs get http://www.cse.unsw.edu.au/~dons/code/pqc-
Test/QuickCheck/Parallel.hs view
@@ -1,10 +1,11 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Test.QuickCheck.Parallel -- Copyright : (c) Don Stewart 2006 -- License : BSD-style (see the file LICENSE)--- --- Maintainer : dons@cse.unsw.edu.au+--+-- Maintainer : shelarcy <shelarcy@gmail.com> -- Stability : experimental -- Portability : non-portable (uses Control.Exception, Control.Concurrent) --@@ -13,16 +14,28 @@ -- module Test.QuickCheck.Parallel (- module Test.QuickCheck,- pRun,- pDet,- pNon- ) where+ module Test.QuickCheck,+ pRun,+ pRun',+ pRunAllProcessors,+ pRunWithNum,+ pDet,+ pNon ) where import Test.QuickCheck-import Data.List+import Test.QuickCheck.Gen (unGen)+import Test.QuickCheck.Test (test)+import Test.QuickCheck.Text (newNullTerminal)+import Test.QuickCheck.State+ import Control.Concurrent-import Control.Exception hiding (evaluate)+#if __GLASGOW_HASKELL__ < 702+import GHC.Conc (numCapabilities)+#elif __GLASGOW_HASKELL__ < 704+#else+import GHC.Conc (getNumProcessors, setNumCapabilities)+#endif+import Control.Monad (forM_, unless) import System.Random import System.IO (hFlush,stdout) import Text.Printf@@ -31,6 +44,38 @@ type Depth = Int type Test = (Name, Depth -> IO String) +-- | Deprecated: Backwards-compatible API+{-# DEPRECATED pRun "use pRun' or pRunAllProcessors, pRunWithNum instead." #-}+pRun :: Int -> Int -> [Test] -> IO ()+pRun = pRunWithNum++-- | Variant of 'pRunWithNum'. Run a list of QuickCheck properties in parallel+-- chunks, using number of Haskell threads that can run truly simultaneously+-- (on separate physical processors) at any given time. (see 'getNumCapabilities'+-- for more details).+pRun' :: Int -> [Test] -> IO ()+pRun' depth tests = do+#if __GLASGOW_HASKELL__ >= 702+ num <- getNumCapabilities+#else+ let num = numCapabilities+#endif+ pRun num depth tests++-- | Variant of 'pRunWithNum'. Run a list of QuickCheck properties in parallel+-- chunks, using all Processors.+pRunAllProcessors :: Int -> [Test] -> IO ()+#if __GLASGOW_HASKELL__ < 704+pRunAllProcessors = pRun'+#else+pRunAllProcessors depth tests = do+ caps <- getNumCapabilities+ pros <- getNumProcessors+ unless (caps == pros)+ $ setNumCapabilities pros+ pRun pros depth tests+#endif+ -- | Run a list of QuickCheck properties in parallel chunks, using -- 'n' Haskell threads (first argument), and test to a depth of 'd' -- (second argument). Compile your application with '-threaded' and run@@ -44,8 +89,8 @@ -- -- Will run 'n' threads over the property list, to depth 1000. ---pRun :: Int -> Int -> [Test] -> IO ()-pRun n depth tests = do+pRunWithNum :: Int -> Int -> [Test] -> IO ()+pRunWithNum n depth tests = do chan <- newChan ps <- getChanContents chan work <- newMVar tests@@ -53,10 +98,10 @@ forM_ [1..n] $ forkIO . thread work chan let wait xs i- | i >= n = return () -- done+ | i >= n = return () -- done | otherwise = case xs of- Nothing : xs -> wait xs $! i+1- Just s : xs -> putStr s >> hFlush stdout >> wait xs i+ Nothing : ys -> wait ys $! i+1+ Just s : ys -> putStr s >> hFlush stdout >> wait ys i wait ps 0 where@@ -74,75 +119,54 @@ writeChan chan . Just $ printf "%d: %-25s: %s" me name v loop - -- | Wrap a property, and run it on a deterministic set of data pDet :: Testable a => a -> Int -> IO String-pDet a n = mycheck Det defaultConfig- { configMaxTest = n- , configEvery = \n args -> unlines args } a+pDet a n =+ do result <- mycheck Det (stdArgs { maxSuccess = n }) a+ return $ output result -- | Wrap a property, and run it on a non-deterministic set of data pNon :: Testable a => a -> Int -> IO String-pNon a n = mycheck NonDet defaultConfig- { configMaxTest = n- , configEvery = \n args -> unlines args } a+pNon a n =+ do result <- mycheck NonDet (stdArgs { maxSuccess = n }) a+ return $ output result data Mode = Det | NonDet ------------------------------------------------------------------------ -mycheck :: Testable a => Mode -> Config -> a -> IO String+mycheck :: Testable a => Mode -> Args -> a -> IO Result mycheck Det config a = do let rnd = mkStdGen 99 -- deterministic- mytests config (evaluate a) rnd 0 0 []+ mytests config rnd a mycheck NonDet config a = do rnd <- newStdGen -- different each run- mytests config (evaluate a) rnd 0 0 []--mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO String-mytests config gen rnd0 ntest nfail stamps- | ntest == configMaxTest config = do done "OK," ntest stamps- | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps- | otherwise = do- case ok result of- Nothing ->- mytests config gen rnd1 ntest (nfail+1) stamps- Just True ->- mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps)- Just False ->- return ( "Falsifiable after "- ++ show ntest- ++ " tests:\n"- ++ unlines (arguments result)- )- where- result = generate (configSize config ntest) rnd2 gen- (rnd1,rnd2) = split rnd0--done :: String -> Int -> [[String]] -> IO String-done mesg ntest stamps =- return ( mesg ++ " " ++ show ntest ++ " tests" ++ table )- where- table = display- . map entry- . reverse- . sort- . map pairLength- . group- . sort- . filter (not . null)- $ stamps-- display [] = ".\n"- display [x] = " (" ++ x ++ ").\n"- display xs = ".\n" ++ unlines (map (++ ".") xs)-- pairLength xss@(xs:_) = (length xss, xs)- entry (n, xs) = percentage n ntest- ++ " "- ++ concat (intersperse ", " xs)-- percentage n m = show ((100 * n) `div` m) ++ "%"+ mytests config rnd a -forM_ = flip mapM_+mytests :: Testable prop => Args -> StdGen -> prop -> IO Result+mytests a rnd p =+ do tm <- newNullTerminal+ test MkState{ terminal = tm+ , maxSuccessTests = maxSuccess a+ , maxDiscardedTests = maxDiscard a+ , computeSize = case replay a of+ Nothing -> computeSize'+ Just (_,s) -> \_ _ -> s+ , numSuccessTests = 0+ , numDiscardedTests = 0+ , collected = []+ , expectedFailure = False+ , randomSeed = rnd+ , numSuccessShrinks = 0+ , numTryShrinks = 0+ } (unGen (property p))+ where computeSize' n d+ -- e.g. with maxSuccess = 250, maxSize = 100, goes like this:+ -- 0, 1, 2, ..., 99, 0, 1, 2, ..., 99, 0, 2, 4, ..., 98.+ | n `roundTo` maxSize a + maxSize a <= maxSuccess a ||+ n >= maxSuccess a ||+ maxSuccess a `mod` maxSize a == 0 = n `mod` maxSize a + d `div` 10+ | otherwise =+ (n `mod` maxSize a) * maxSize a `div` (maxSuccess a `mod` maxSize a) + d `div` 10+ n `roundTo` m = (n `div` m) * m
− examples/Example.hs
@@ -1,52 +0,0 @@--- ------ $ ghc -O -package pqc Example.hs -threaded--- -----import Test.QuickCheck.Parallel-import Data.List-import System.Environment--prop_sort1 xs = sort xs == sortBy compare xs- where types = (xs :: [Int])--prop_sort2 xs =- (not (null xs)) ==>- (head (sort xs) == minimum xs)- where types = (xs :: [Int])--prop_sort3 xs = (not (null xs)) ==>- last (sort xs) == maximum xs- where types = (xs :: [Int])--prop_sort4 xs ys =- (not (null xs)) ==>- (not (null ys)) ==>- (head (sort (xs ++ ys)) == min (minimum xs) (minimum ys))- where types = (xs :: [Int], ys :: [Int])--prop_sort6 xs ys =- (not (null xs)) ==>- (not (null ys)) ==>- (last (sort (xs ++ ys)) == max (maximum xs) (maximum ys))- where types = (xs :: [Int], ys :: [Int])--prop_sort5 xs ys =- (not (null xs)) ==>- (not (null ys)) ==>- (head (sort (xs ++ ys)) == max (maximum xs) (maximum ys))- where types = (xs :: [Int], ys :: [Int])------- Run in 4 threads, to depth of 1000----main = do- n <- getArgs >>= readIO . head- pRun n 1000 $ take 100 $ cycle- [ ("sort1", pDet prop_sort1)- , ("sort2", pDet prop_sort2)- , ("sort3", pDet prop_sort3)- , ("sort4", pDet prop_sort4)- , ("sort5", pDet prop_sort5)- ]
pqc.cabal view
@@ -1,21 +1,26 @@ name: pqc-version: 0.2+version: 0.3 description: Parallel batch driver for QuickCheck synopsis: Parallel batch driver for QuickCheck category: Testing license: BSD3 license-file: LICENSE Author: Don Stewart-Maintainer: dons@cse.unsw.edu.au-homepage: http://code.haskell.org/~dons/code/pqc-Cabal-Version: >= 1.2+Maintainer: shelarcy <shelarcy@gmail.com>+homepage: http://darcsden.com/shelarcy/pqc+build-type: Simple+Cabal-Version: >= 1.6 +source-repository head+ type: darcs+ location: http://darcsden.com/shelarcy/pqc+ flag split-base library if flag(split-base)- build-depends: base >= 3, random, QuickCheck < 2+ build-depends: base >= 3 && < 5, random, QuickCheck > 2.1 && < 3 else- build-depends: base < 3, QuickCheck < 2+ build-depends: base < 3, QuickCheck > 2.1 && < 3 exposed-modules: Test.QuickCheck.Parallel ghc-options: -Wall -O2