Commits

Bryan O'Sullivan committed 7947c1f Merge

Merge

Comments (0)

Files changed (3)

     , bgroup
     , runBenchmark
     , runAndAnalyse
+    , runNotAnalyse
     ) where
 
 import Control.Monad (replicateM_, when, mplus)
             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

Criterion/Config.hs

     , 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
                 , cfgTemplate     = ljust "report.tpl"
                 , cfgVerbosity    = ljust Normal
                 , cfgJUnitFile    = mempty
+                , cfgMeasure      = ljust True
                 }
 
 -- | Constructor for 'Last' values.
               , cfgTemplate     = mempty
               , cfgVerbosity    = mempty
               , cfgJUnitFile    = mempty
+              , cfgMeasure      = mempty
               }
 
 appendConfig :: Config -> Config -> Config
     , 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

Criterion/Main.hs

     ) 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)
           "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 })
                 -> 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.
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.