diff --git a/checkers.cabal b/checkers.cabal index 9013527..c36425a 100644 --- a/checkers.cabal +++ b/checkers.cabal @@ -1,5 +1,5 @@ Name: checkers -Version: 0.5.6 +Version: 0.5.7 Cabal-Version: >= 1.10 Synopsis: Check properties on standard classes and data structures. Category: Testing diff --git a/src/Test/QuickCheck/Checkers.hs b/src/Test/QuickCheck/Checkers.hs index c0e1f0d..016c66d 100644 --- a/src/Test/QuickCheck/Checkers.hs +++ b/src/Test/QuickCheck/Checkers.hs @@ -98,17 +98,21 @@ unbatch (batchName,props) = map (first ((batchName ++ ": ")++)) props -- TODO: consider a tree structure so that flattening is unnecessary. +type QuickCheckRunner = Args -> Property -> IO () + -- | Run a batch of tests. See 'quickBatch' and 'verboseBatch'. -checkBatch :: Args -> TestBatch -> IO () -checkBatch args (name,tests) = +checkBatch' :: QuickCheckRunner -> Args -> TestBatch -> IO () +checkBatch' runner args (name,tests) = do putStrLn $ "\n" ++ name ++ ":" mapM_ pr tests where pr (s,p) = do putStr (padTo (width + 4) (" "++s ++ ":")) - Ex.catch (quickCheckWith args p) + Ex.catch (runner args p) (print :: Ex.SomeException -> IO ()) width = foldl' max 0 (map (length.fst) tests) +checkBatch :: Args -> TestBatch -> IO () +checkBatch = checkBatch' quickCheckWith padTo :: Int -> String -> String padTo n = take n . (++ repeat ' ') @@ -119,14 +123,10 @@ quickBatch = checkBatch quick' -- | Check a batch verbosely. verboseBatch :: TestBatch -> IO () -verboseBatch = checkBatch verbose' +verboseBatch = checkBatch' verboseCheckWith quick' -quick', verbose' :: Args +quick' :: Args quick' = stdArgs { maxSuccess = 500 } -verbose' = quick' - -- quick' { configEvery = \ n args -> show n ++ ":\n" ++ unlines args } - --- TODO: Restore verbose functionality. How in QC2? {-