diff --git a/Criterion.hs b/Criterion.hs --- a/Criterion.hs +++ b/Criterion.hs @@ -23,6 +23,7 @@ , bgroup , runBenchmark , runAndAnalyse + , runNotAnalyse ) where import Control.Monad (replicateM_, when, mplus) @@ -155,13 +156,34 @@ concat `fmap` mapM (go (prefix pfx desc)) bs go pfx (BenchCompare bs) = ((:[]) . Compare . concat) `fmap` mapM (go pfx) bs - prefix "" desc = desc - prefix pfx desc = pfx ++ '/' : desc +runNotAnalyse :: (String -> Bool) -- ^ A predicate that chooses + -- whether to run a benchmark by its + -- name. + -> Benchmark + -> Criterion () +runNotAnalyse p bs' = goQuickly "" bs' + where goQuickly :: String -> Benchmark -> Criterion () + goQuickly pfx (Benchmark desc b) + | p desc' = do _ <- note "benchmarking %s\n" desc' + runOne b + | otherwise = return () + where desc' = prefix pfx desc + goQuickly pfx (BenchGroup desc bs) = + mapM_ (goQuickly (prefix pfx desc)) bs + goQuickly pfx (BenchCompare bs) = mapM_ (goQuickly pfx) bs - flatten :: ResultForest -> [Result] - flatten [] = [] - flatten (Single r : rs) = r : flatten rs - flatten (Compare crs : rs) = flatten crs ++ flatten rs + runOne b = do + samples <- getConfigItem $ fromLJ cfgSamples + liftIO $ run b samples + +prefix :: String -> String -> String +prefix "" desc = desc +prefix pfx desc = pfx ++ '/' : desc + +flatten :: ResultForest -> [Result] +flatten [] = [] +flatten (Single r : rs) = r : flatten rs +flatten (Compare crs : rs) = flatten crs ++ flatten rs resultForestToCSV :: ResultForest -> String resultForestToCSV = unlines diff --git a/Criterion/Config.hs b/Criterion/Config.hs --- a/Criterion/Config.hs +++ b/Criterion/Config.hs @@ -57,6 +57,7 @@ , cfgTemplate :: Last FilePath -- ^ Filename of report template. , cfgVerbosity :: Last Verbosity -- ^ Whether to run verbosely. , cfgJUnitFile :: Last FilePath -- ^ Filename of JUnit report. + , cfgMeasure :: Last Bool -- ^ Whether to do any measurement. } deriving (Eq, Read, Show, Typeable) instance Monoid Config where @@ -78,6 +79,7 @@ , cfgTemplate = ljust "report.tpl" , cfgVerbosity = ljust Normal , cfgJUnitFile = mempty + , cfgMeasure = ljust True } -- | Constructor for 'Last' values. @@ -106,6 +108,7 @@ , cfgTemplate = mempty , cfgVerbosity = mempty , cfgJUnitFile = mempty + , cfgMeasure = mempty } appendConfig :: Config -> Config -> Config @@ -123,5 +126,6 @@ , cfgTemplate = app cfgTemplate a b , cfgVerbosity = app cfgVerbosity a b , cfgJUnitFile = app cfgJUnitFile a b + , cfgMeasure = app cfgMeasure a b } where app f = mappend `on` f diff --git a/Criterion/Main.hs b/Criterion/Main.hs --- a/Criterion/Main.hs +++ b/Criterion/Main.hs @@ -45,7 +45,7 @@ ) where import Control.Monad.Trans (liftIO) -import Criterion (runAndAnalyse) +import Criterion (runAndAnalyse, runNotAnalyse) import Criterion.Config import Criterion.Environment (measureEnvironment) import Criterion.IO (note, printError) @@ -114,6 +114,8 @@ "produce a summary CSV file of all results" , Option ['r'] ["compare"] (ReqArg (\s -> return $ mempty { cfgCompareFile = ljust s }) "FILENAME") "produce a CSV file of comparisons\nagainst reference benchmarks.\nSee the bcompare combinator" + , Option ['n'] ["no-measurements"] (noArg mempty { cfgMeasure = ljust False }) + "Don't do any measurements" , Option ['V'] ["version"] (noArg mempty { cfgPrintExit = Version }) "display version, then exit" , Option ['v'] ["verbose"] (noArg mempty { cfgVerbosity = ljust Verbose }) @@ -173,7 +175,6 @@ -- Example: -- -- > import Criterion.Config --- > import qualified Criterion.MultiMap as M -- > import Criterion.Main -- > -- > myConfig = defaultConfig { @@ -198,19 +199,24 @@ -> IO () defaultMainWith defCfg prep bs = do (cfg, args) <- parseArgs defCfg defaultOptions =<< getArgs + let shouldRun b = null args || any (`isPrefixOf` b) args withConfig cfg $ - if cfgPrintExit cfg == List - then do - _ <- note "Benchmarks:\n" - mapM_ (note " %s\n") (sort $ concatMap benchNames bs) - else do - case getLast $ cfgSummaryFile cfg of - Just fn -> liftIO $ writeFile fn "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB\n" - Nothing -> return () - env <- measureEnvironment - let shouldRun b = null args || any (`isPrefixOf` b) args - prep - runAndAnalyse shouldRun env $ BenchGroup "" bs + if not $ fromLJ cfgMeasure cfg + then runNotAnalyse shouldRun bsgroup + else do + if cfgPrintExit cfg == List + then do + _ <- note "Benchmarks:\n" + mapM_ (note " %s\n") (sort $ concatMap benchNames bs) + else do + case getLast $ cfgSummaryFile cfg of + Just fn -> liftIO $ writeFile fn "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB\n" + Nothing -> return () + env <- measureEnvironment + prep + runAndAnalyse shouldRun env bsgroup + where + bsgroup = BenchGroup "" bs -- | Display an error message from a command line parsing failure, and -- exit. diff --git a/Criterion/Report.hs b/Criterion/Report.hs --- a/Criterion/Report.hs +++ b/Criterion/Report.hs @@ -41,7 +41,7 @@ import System.FilePath ((), isPathSeparator) import System.IO.Unsafe (unsafePerformIO) import Text.Hastache (MuType(..)) -import Text.Hastache.Context (mkGenericContext, mkStrContext) +import Text.Hastache.Context (mkGenericContext, mkStrContext, mkStrContextM) import qualified Control.Exception as E import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as L @@ -80,17 +80,17 @@ -> B.ByteString -- ^ Hastache template. -> IO L.ByteString formatReport reports template = do - let context "report" = MuList $ map inner reports - context "include" = MuLambdaM $ includeFile [templateDir] - context _ = MuNothing - inner Report{..} = mkStrContext $ \nym -> + let context "report" = return $ MuList $ map inner reports + context "include" = return $ MuLambdaM $ includeFile [templateDir] + context _ = return $ MuNothing + inner Report{..} = mkStrContextM $ \nym -> case nym of - "name" -> MuVariable reportName - "number" -> MuVariable reportNumber - "times" -> vector "x" reportTimes - "kdetimes" -> vector "x" kdeTimes - "kdepdf" -> vector "x" kdePDF - "kde" -> vector2 "time" "pdf" kdeTimes kdePDF + "name" -> return $ MuVariable reportName + "number" -> return $ MuVariable reportNumber + "times" -> return $ vector "x" reportTimes + "kdetimes" -> return $ vector "x" kdeTimes + "kdepdf" -> return $ vector "x" kdePDF + "kde" -> return $ vector2 "time" "pdf" kdeTimes kdePDF ('a':'n':_)-> mkGenericContext reportAnalysis $ H.encodeStr nym _ -> mkGenericContext reportOutliers $ diff --git a/criterion.cabal b/criterion.cabal --- a/criterion.cabal +++ b/criterion.cabal @@ -1,11 +1,11 @@ name: criterion -version: 0.6.2.0 +version: 0.6.2.1 synopsis: Robust, reliable performance measurement and analysis license: BSD3 license-file: LICENSE author: Bryan O'Sullivan maintainer: Bryan O'Sullivan -copyright: 2009, 2010, 2011 Bryan O'Sullivan +copyright: 2009-2013 Bryan O'Sullivan category: Development, Performance, Testing, Benchmarking homepage: https://github.com/bos/criterion bug-reports: https://github.com/bos/criterion/issues @@ -61,7 +61,7 @@ deepseq >= 1.1.0.0, directory, filepath, - hastache >= 0.1.5, + hastache >= 0.5.0, mtl >= 2, mwc-random >= 0.8.0.3, parsec >= 3.1.0,