diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright Don Stewart 2006. + +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 Don Stewart 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. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,79 @@ +------------------------------------------------------------------------ +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/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/Test/QuickCheck/Parallel.hs b/Test/QuickCheck/Parallel.hs new file mode 100644 --- /dev/null +++ b/Test/QuickCheck/Parallel.hs @@ -0,0 +1,148 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Test.QuickCheck.Parallel +-- Copyright : (c) Don Stewart 2006 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : dons@cse.unsw.edu.au +-- Stability : experimental +-- Portability : non-portable (uses Control.Exception, Control.Concurrent) +-- +-- A parallel batch driver for running QuickCheck on threaded or SMP systems. +-- See the /Example.hs/ file for a complete overview. +-- + +module Test.QuickCheck.Parallel ( + module Test.QuickCheck, + pRun, + pDet, + pNon + ) where + +import Test.QuickCheck +import Data.List +import Control.Concurrent +import Control.Exception hiding (evaluate) +import System.Random +import System.IO (hFlush,stdout) +import Text.Printf + +type Name = String +type Depth = Int +type Test = (Name, Depth -> IO String) + +-- | 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 +-- with the SMP runtime's '-N4' (or however many OS threads you want to +-- donate), for best results. +-- +-- > import Test.QuickCheck.Parallel +-- > +-- > do n <- getArgs >>= readIO . head +-- > pRun n 1000 [ ("sort1", pDet prop_sort1) ] +-- +-- Will run 'n' threads over the property list, to depth 1000. +-- +pRun :: Int -> Int -> [Test] -> IO () +pRun n depth tests = do + chan <- newChan + ps <- getChanContents chan + work <- newMVar tests + + forM_ [1..n] $ forkIO . thread work chan + + let wait xs i + | i >= n = return () -- done + | otherwise = case xs of + Nothing : xs -> wait xs $! i+1 + Just s : xs -> putStr s >> hFlush stdout >> wait xs i + wait ps 0 + + where + thread :: MVar [Test] -> Chan (Maybe String) -> Int -> IO () + thread work chan me = loop + where + loop = do + job <- modifyMVar work $ \jobs -> return $ case jobs of + [] -> ([], Nothing) + (j:js) -> (js, Just j) + case job of + Nothing -> writeChan chan Nothing -- done + Just (name,prop) -> do + v <- prop depth + 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 + +-- | 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 + +data Mode = Det | NonDet + +------------------------------------------------------------------------ + +mycheck :: Testable a => Mode -> Config -> a -> IO String +mycheck Det config a = do + let rnd = mkStdGen 99 -- deterministic + mytests config (evaluate a) rnd 0 0 [] + +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) ++ "%" + +forM_ = flip mapM_ diff --git a/examples/Example.hs b/examples/Example.hs new file mode 100644 --- /dev/null +++ b/examples/Example.hs @@ -0,0 +1,52 @@ +-- +-- +-- $ 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 new file mode 100644 --- /dev/null +++ b/pqc.cabal @@ -0,0 +1,12 @@ +Name: pqc +Version: 0.1 +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 +Build-Depends: base, QuickCheck +Exposed-modules: Test.QuickCheck.Parallel +ghc-options: -O