pqc (empty) → 0.1
raw patch · 6 files changed
+325/−0 lines, 6 filesdep +QuickCheckdep +basebuild-type:Customsetup-changed
Dependencies added: QuickCheck, base
Files
- LICENSE +31/−0
- README +79/−0
- Setup.lhs +3/−0
- Test/QuickCheck/Parallel.hs +148/−0
- examples/Example.hs +52/−0
- pqc.cabal +12/−0
+ LICENSE view
@@ -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.
+ README view
@@ -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+
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ Test/QuickCheck/Parallel.hs view
@@ -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_
+ examples/Example.hs view
@@ -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)+ ]
+ pqc.cabal view
@@ -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