diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -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 - diff --git a/Test/QuickCheck/Parallel.hs b/Test/QuickCheck/Parallel.hs --- a/Test/QuickCheck/Parallel.hs +++ b/Test/QuickCheck/Parallel.hs @@ -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 -- 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 diff --git a/examples/Example.hs b/examples/Example.hs deleted file mode 100644 --- a/examples/Example.hs +++ /dev/null @@ -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) - ] diff --git a/pqc.cabal b/pqc.cabal --- a/pqc.cabal +++ b/pqc.cabal @@ -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 +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