diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,7 +3,8 @@ Featherlight benchmark framework (only one file!) for performance measurement with API mimicking [`criterion`](http://hackage.haskell.org/package/criterion) and [`gauge`](http://hackage.haskell.org/package/gauge). -A prominent feature is built-in comparison against baseline. +A prominent feature is built-in comparison against previous runs +and between benchmarks. ## How lightweight is it? @@ -40,7 +41,7 @@ build-depends: tasty-bench mixins: - tasty-bench (Test.Tasty.Bench as Criterion, Test.Tasty.Bench as Criterion.Main) + tasty-bench (Test.Tasty.Bench as Criterion, Test.Tasty.Bench as Criterion.Main, Test.Tasty.Bench as Gauge, Test.Tasty.Bench as Gauge.Main) ``` This works vice versa as well: if you use `tasty-bench`, but at some point @@ -61,8 +62,11 @@ benchmark bench-fibo main-is: BenchFibo.hs type: exitcode-stdio-1.0 - ghc-options: "-with-rtsopts=-A32m" build-depends: base, tasty-bench + if impl(ghc >= 8.10) + ghc-options: "-with-rtsopts=-A32m --nonmoving-gc" + else + ghc-options: "-with-rtsopts=-A32m" ``` And here is `BenchFibo.hs`: @@ -273,6 +277,9 @@ Alternatively bake it into `cabal` file as `ghc-options: "-with-rtsopts=-A32m"`. + For GHC >= 8.10 consider switching benchmarks to a non-moving garbage collector, + because it decreases GC pauses and corresponding noise: `+RTS --nonmoving-gc`. + * If benchmark results look malformed like below, make sure that you are invoking `Test.Tasty.Bench.defaultMain` and not `Test.Tasty.defaultMain` (the difference is `consoleBenchReporter` vs. `consoleTestReporter`): @@ -403,6 +410,56 @@ [`tasty-rerun`](http://hackage.haskell.org/package/tasty-rerun) package to focus on rerunning failing items only. +## Comparison between benchmarks + +You can also compare benchmarks to each other without reaching to external tools, +all in the comfort of your terminal. + +```haskell +import Test.Tasty.Bench + +fibo :: Int -> Integer +fibo n = if n < 2 then toInteger n else fibo (n - 1) + fibo (n - 2) + +main :: IO () +main = defaultMain + [ bgroup "fibonacci numbers" + [ bcompare "tenth" $ bench "fifth" $ nf fibo 5 + , bench "tenth" $ nf fibo 10 + , bcompare "tenth" $ bench "twentieth" $ nf fibo 20 + ] + ] +``` + +This produces a report, comparing mean times of `fifth` and `twentieth` to `tenth`: + +``` +All + fibonacci numbers + fifth: OK (16.56s) + 121 ns ± 2.6 ns, 0.08x + tenth: OK (6.84s) + 1.6 μs ± 31 ns + twentieth: OK (6.96s) + 203 μs ± 4.1 μs, 128.36x +``` + +Locating a baseline benchmark in larger suites could get tricky; + +```haskell +bcompare "$NF == \"tenth\" && $(NF-1) == \"fibonacci numbers\"" +``` + +is a more robust choice of +an [`awk` pattern](https://github.com/feuerbach/tasty#patterns) here. + +## Plotting results + +Users can dump results into CSV with `--csv FILE` +and plot them using `gnuplot` or other software. But for convenience +there is also a built-in quick-and-dirty SVG plotting feature, +which can be invoked by passing `--svg FILE`. + ## Command-line options Use `--help` to list command-line options. @@ -442,3 +499,7 @@ Upper bounds of acceptable slow down / speed up in percents. If a benchmark is unacceptably slower / faster than baseline (see `--baseline`), it will be reported as failed. Can be used in conjunction with a standard `tasty` option `--hide-successes` to show only problematic benchmarks. + +* `--svg` + + File to plot results in SVG format. diff --git a/Test/Tasty/Bench.hs b/Test/Tasty/Bench.hs --- a/Test/Tasty/Bench.hs +++ b/Test/Tasty/Bench.hs @@ -7,7 +7,8 @@ measurement with API mimicking [@criterion@](http://hackage.haskell.org/package/criterion) and [@gauge@](http://hackage.haskell.org/package/gauge). -A prominent feature is built-in comparison against baseline. +A prominent feature is built-in comparison against previous runs +and between benchmarks. === How lightweight is it? @@ -46,7 +47,7 @@ > build-depends: > tasty-bench > mixins: -> tasty-bench (Test.Tasty.Bench as Criterion, Test.Tasty.Bench as Criterion.Main) +> tasty-bench (Test.Tasty.Bench as Criterion, Test.Tasty.Bench as Criterion.Main, Test.Tasty.Bench as Gauge, Test.Tasty.Bench as Gauge.Main) This works vice versa as well: if you use @tasty-bench@, but at some point need a more comprehensive statistical analysis, it is easy to @@ -65,8 +66,11 @@ > benchmark bench-fibo > main-is: BenchFibo.hs > type: exitcode-stdio-1.0 -> ghc-options: "-with-rtsopts=-A32m" > build-depends: base, tasty-bench +> if impl(ghc >= 8.10) +> ghc-options: "-with-rtsopts=-A32m --nonmoving-gc" +> else +> ghc-options: "-with-rtsopts=-A32m" And here is @BenchFibo.hs@: @@ -261,6 +265,9 @@ @stack@ @bench@ @--ba@ @\'+RTS@ @-A32m\'@. Alternatively bake it into @cabal@ file as @ghc-options:@ @\"-with-rtsopts=-A32m\"@. + For GHC >= 8.10 consider switching benchmarks to a non-moving garbage collector, + because it decreases GC pauses and corresponding noise: @+RTS@ @--nonmoving-gc@. + - If benchmark results look malformed like below, make sure that you are invoking 'Test.Tasty.Bench.defaultMain' and not 'Test.Tasty.defaultMain' (the difference is 'consoleBenchReporter' @@ -378,6 +385,53 @@ even [@tasty-rerun@](http://hackage.haskell.org/package/tasty-rerun) package to focus on rerunning failing items only. +=== Comparison between benchmarks + +You can also compare benchmarks to each other without reaching to +external tools, all in the comfort of your terminal. + +> import Test.Tasty.Bench +> +> fibo :: Int -> Integer +> fibo n = if n < 2 then toInteger n else fibo (n - 1) + fibo (n - 2) +> +> main :: IO () +> main = defaultMain +> [ bgroup "fibonacci numbers" +> [ bcompare "tenth" $ bench "fifth" $ nf fibo 5 +> , bench "tenth" $ nf fibo 10 +> , bcompare "tenth" $ bench "twentieth" $ nf fibo 20 +> ] +> ] + +This produces a report, comparing mean times of @fifth@ and @twentieth@ +to @tenth@: + +> All +> fibonacci numbers +> fifth: OK (16.56s) +> 121 ns ± 2.6 ns, 0.08x +> tenth: OK (6.84s) +> 1.6 μs ± 31 ns +> twentieth: OK (6.96s) +> 203 μs ± 4.1 μs, 128.36x + +Locating a baseline benchmark in larger suites could get tricky; + +> bcompare "$NF == \"tenth\" && $(NF-1) == \"fibonacci numbers\"" + +is a more robust choice of +an here. + +=== Plotting results + +Users can dump results into CSV with @--csv@ @FILE@ and plot them using +@gnuplot@ or other software. But for convenience there is also a +built-in quick-and-dirty SVG plotting feature, which can be invoked by +passing @--svg@ @FILE@. Here is a sample of its output: + +![Plotting](example.svg) + === Command-line options Use @--help@ to list command-line options. @@ -423,6 +477,10 @@ conjunction with a standard @tasty@ option @--hide-successes@ to show only problematic benchmarks. +[@--svg@]: + + File to plot results in SVG format. + -} {-# LANGUAGE CPP #-} @@ -439,6 +497,7 @@ , Benchmark , bench , bgroup + , bcompare , env , envWithCleanup -- * Creating 'Benchmarkable' @@ -453,6 +512,7 @@ , benchIngredients , consoleBenchReporter , csvReporter + , svgReporter , RelStDev(..) , FailIfSlower(..) , FailIfFaster(..) @@ -460,17 +520,21 @@ import Prelude hiding (Int, Integer) import Control.Applicative +import Control.Arrow (first, second) import Control.DeepSeq (NFData, force) import Control.Exception (bracket, evaluate) -import Control.Monad (void, unless, guard, (>=>)) +import Control.Monad (void, unless, guard, (>=>), when) import Data.Data (Typeable) import Data.Foldable (foldMap, traverse_) import Data.Int (Int64) import Data.IntMap (IntMap) import qualified Data.IntMap as IM -import Data.List (intercalate, stripPrefix, isPrefixOf) +import Data.IORef +import Data.List (intercalate, stripPrefix, isPrefixOf, foldl', genericLength, genericDrop) import Data.Monoid (All(..), Any(..)) import Data.Proxy +import Data.Sequence (Seq, (<|)) +import qualified Data.Sequence as Seq #if MIN_VERSION_containers(0,5,0) import Data.Set (lookupGE) #endif @@ -488,6 +552,8 @@ import Test.Tasty.Ingredients import Test.Tasty.Ingredients.ConsoleReporter import Test.Tasty.Options +import Test.Tasty.Patterns.Eval (eval, asB, withFields) +import Test.Tasty.Patterns.Types (Expr (And, StringLit)) import Test.Tasty.Providers import Test.Tasty.Runners import Text.Printf @@ -710,10 +776,17 @@ Timeout micros _ -> (sumOfTs + measTime t1 + 3 * measTime t2) `quot` (1000000 * 10 `quot` 12) >= fromInteger micros isStDevInTargetRange = stdevN < truncate (max 0 targetRelStDev * fromIntegral meanN) scale = (`quot` fromIntegral n) + sumOfTs' = sumOfTs + measTime t1 + case timeout of + NoTimeout | sumOfTs' > 100 * 1000000000000 + -> hPutStrLn stderr "This benchmark takes more than 100 seconds. Consider setting --timeout, if this is unexpected (or to silence this warning)." + _ -> pure () + + if isStDevInTargetRange || isTimeoutSoon then pure $ Estimate (Measurement (scale meanN) (scale allocN) (scale copiedN)) (scale stdevN) - else go (2 * n) t2 (sumOfTs + measTime t1) + else go (2 * n) t2 sumOfTs' instance IsTest Benchmarkable where testOptions = pure @@ -727,7 +800,7 @@ 1 -> do est <- measureTimeUntil (lookupOption opts) (lookupOption opts) b pure $ testPassed $ show (Response est (lookupOption opts) (lookupOption opts)) - _ -> pure $ testFailed "Benchmarks should be run in a single-threaded mode (--jobs 1)" + _ -> pure $ testFailed "Benchmarks must not be run concurrently. Please pass --jobs 1 and/or avoid +RTS -N." -- | Attach a name to 'Benchmarkable'. -- @@ -746,6 +819,26 @@ bgroup :: String -> [Benchmark] -> Benchmark bgroup = testGroup +-- | Compare benchmarks, reporting relative speed up or slow down. +-- +-- The first argument is a @tasty@ pattern, which must unambiguously +-- match a unique baseline benchmark. Locating a benchmark in a global environment +-- may be tricky, please refer to +-- [@tasty@ documentation](https://github.com/feuerbach/tasty#patterns) for details. +-- +-- A benchmark (or a group of benchmarks), specified in the second argument, +-- will be compared against the baseline benchmark by dividing measured mean times. +-- The result is reported by 'consoleBenchReporter', e. g., 0.50x or 1.25x. +-- +-- This function is a vague reminiscence of @bcompare@, which existed in pre-1.0 +-- versions of @criterion@, but their types are incompatible. Under the hood +-- 'bcompare' is a thin wrapper over 'after'. +-- +bcompare :: String -> Benchmark -> Benchmark +bcompare s = case parseExpr s of + Nothing -> error $ "Could not parse bcompare pattern " ++ s + Just e -> after_ AllSucceed (And (StringLit "tasty-bench") e) + -- | Benchmarks are actually just a regular 'Test.Tasty.TestTree' in disguise. -- -- This is a drop-in replacement for 'Criterion.Benchmark' and 'Gauge.Benchmark'. @@ -762,7 +855,7 @@ -- | List of default benchmark ingredients. This is what 'defaultMain' runs. -- benchIngredients :: [Ingredient] -benchIngredients = [listingTests, composeReporters consoleBenchReporter csvReporter] +benchIngredients = [listingTests, composeReporters consoleBenchReporter (composeReporters csvReporter svgReporter)] funcToBench :: (b -> c) -> (a -> b) -> a -> Benchmarkable funcToBench frc = (Benchmarkable .) . go @@ -1088,6 +1181,123 @@ = '"' : concatMap (\x -> if x == '"' then "\"\"" else [x]) xs ++ "\"" | otherwise = xs +newtype SvgPath = SvgPath { _unSvgPath :: FilePath } + deriving (Typeable) + +instance IsOption (Maybe SvgPath) where + defaultValue = Nothing + parseValue = Just . Just . SvgPath + optionName = pure "svg" + optionHelp = pure "File to plot results in SVG format" + +-- | Run benchmarks and plot results in SVG format. +-- It activates when @--svg@ @FILE@ command line option is specified. +-- +svgReporter :: Ingredient +svgReporter = TestReporter [Option (Proxy :: Proxy (Maybe SvgPath))] $ + \opts tree -> do + SvgPath path <- lookupOption opts + let names = testsNames opts tree + namesMap = IM.fromDistinctAscList $ zip [0..] names + pure $ \smap -> do + ref <- newIORef [] + svgCollect ref (IM.intersectionWith (,) namesMap smap) + res <- readIORef ref + writeFile path (svgRender (reverse res)) + pure $ const ((== 0) . statFailures <$> computeStatistics smap) + +svgCollect :: IORef [(TestName, Estimate)] -> IntMap (TestName, TVar Status) -> IO () +svgCollect ref = traverse_ $ \(name, tv) -> do + r <- atomically $ readTVar tv >>= \s -> case s of Done r -> pure r; _ -> retry + case safeRead (resultDescription r) of + Nothing -> pure () + Just (Response est _ _) -> modifyIORef ref ((name, est) :) + +svgRender :: [(TestName, Estimate)] -> String +svgRender [] = "" +svgRender pairs = header ++ concat (zipWith + (\i (name, est) -> svgRenderItem i l xMax (dropAllPrefix name) est) + [0..] + pairs) ++ footer + where + dropAllPrefix + | all ("All." `isPrefixOf`) (map fst pairs) = drop 4 + | otherwise = id + + l = genericLength pairs + findMaxX (Estimate m stdev) = measTime m + 2 * stdev + xMax = fromIntegral $ maximum $ minBound : map (findMaxX . snd) pairs + header = printf "\n\n" (svgItemOffset l - 15) svgCanvasWidth svgFontSize svgCanvasMargin + footer = "\n\n" + +svgCanvasWidth :: Double +svgCanvasWidth = 960 + +svgCanvasMargin :: Double +svgCanvasMargin = 10 + +svgItemOffset :: Word64 -> Word64 +svgItemOffset i = 22 + 55 * fromIntegral i + +svgFontSize :: Word64 +svgFontSize = 16 + +svgRenderItem :: Word64 -> Word64 -> Double -> TestName -> Estimate -> String +svgRenderItem i iMax xMax name est@(Estimate m stdev) = + (if genericLength shortTextContent * glyphWidth < boxWidth then longText else shortText) ++ box + where + y = svgItemOffset i + y' = y + (svgFontSize * 3) `quot` 8 + y1 = y' + whiskerMargin + y2 = y' + boxHeight `quot` 2 + y3 = y' + boxHeight - whiskerMargin + x1 = boxWidth - whiskerWidth + x2 = boxWidth + whiskerWidth + deg = (i * 360) `quot` iMax + glyphWidth = fromIntegral svgFontSize / 2 + + scale w = fromIntegral w * (svgCanvasWidth - 2 * svgCanvasMargin) / xMax + boxWidth = scale (measTime m) + whiskerWidth = scale (2 * stdev) + boxHeight = 22 + whiskerMargin = 5 + + box = printf boxTemplate + (prettyEstimate est) + y' boxHeight boxWidth deg deg + deg + x1 x2 y2 y2 + x1 x1 y1 y3 + x2 x2 y1 y3 + boxTemplate + = "\n%s\n" + ++ "\n" + ++ "" + ++ "\n" + ++ "\n" + ++ "\n" + ++ "\n\n" + + longText = printf longTextTemplate + deg + y (encodeSvg name) + y boxWidth (showPicos (measTime m)) + longTextTemplate + = "\n" + ++ "%s\n" + ++ "%s\n" + ++ "\n" + + shortTextContent = encodeSvg name ++ " " ++ showPicos (measTime m) + shortText = printf shortTextTemplate deg y shortTextContent + shortTextTemplate = "%s\n" + +encodeSvg :: String -> String +encodeSvg = concatMap $ \x -> case x of + '<' -> "<" + '&' -> "&" + _ -> [x] + newtype BaselinePath = BaselinePath { _unBaselinePath :: FilePath } deriving (Typeable) @@ -1112,17 +1322,23 @@ Just (BaselinePath path) -> S.fromList . lines <$> (readFile path >>= evaluate . force) hasGCStats <- getRTSStatsEnabled let pretty = if hasGCStats then prettyEstimateWithGC else prettyEstimate - pure $ \name r -> case safeRead (resultDescription r) of + pure $ \name depR r -> case safeRead (resultDescription r) of Nothing -> r Just (Response est (FailIfSlower ifSlow) (FailIfFaster ifFast)) -> (if isAcceptable then id else forceFail) - r { resultDescription = pretty est ++ formatSlowDown slowDown } + r { resultDescription = pretty est ++ bcomp ++ formatSlowDown slowDown } where slowDown = compareVsBaseline baseline name est isAcceptable -- ifSlow/ifFast may be infinite, so we cannot 'truncate' = fromIntegral slowDown <= 100 * ifSlow && fromIntegral slowDown >= -100 * ifFast + bcomp = case depR >>= safeRead . resultDescription of + Nothing -> "" + Just (Response depEst _ _) -> printf ", %.2fx" (estTime est / estTime depEst) +estTime :: Estimate -> Double +estTime = fromIntegral . measTime . estMean + -- | Return slow down in percents. compareVsBaseline :: S.Set String -> TestName -> Estimate -> Int64 compareVsBaseline baseline name (Estimate m stdev) = case mOld of @@ -1161,20 +1377,55 @@ forceFail :: Result -> Result forceFail r = r { resultOutcome = Failure TestFailed, resultShortDescription = "FAIL" } -modifyConsoleReporter :: [OptionDescription] -> (OptionSet -> IO (TestName -> Result -> Result)) -> Ingredient +modifyConsoleReporter + :: [OptionDescription] + -> (OptionSet -> IO (TestName -> Maybe Result -> Result -> Result)) + -> Ingredient modifyConsoleReporter desc' iof = TestReporter (desc ++ desc') $ \opts tree -> - let names = IM.fromDistinctAscList $ zip [0..] (testsNames opts tree) - modifySMap = (iof opts >>=) . flip postprocessResult . IM.intersectionWith (,) names + let nameSeqs = IM.fromDistinctAscList $ zip [0..] $ testNameSeqs opts tree + namesAndDeps = IM.fromDistinctAscList $ zip [0..] $ map (second isSingle) + $ testNamesAndDeps nameSeqs opts tree + modifySMap = (iof opts >>=) . flip postprocessResult + . IM.intersectionWith (\(a, b) c -> (a, b, c)) namesAndDeps in (modifySMap >=>) <$> cb opts tree where TestReporter desc cb = consoleTestReporter -postprocessResult :: (TestName -> Result -> Result) -> IntMap (TestName, TVar Status) -> IO StatusMap + isSingle [a] = Just a + isSingle _ = Nothing + +testNameSeqs :: OptionSet -> TestTree -> [Seq TestName] +testNameSeqs = foldTestTree trivialFold + { foldSingle = const $ const . (:[]) . Seq.singleton + , foldGroup = const $ map . (<|) + } + +testNamesAndDeps :: IntMap (Seq TestName) -> OptionSet -> TestTree -> [(TestName, [IM.Key])] +testNamesAndDeps im = foldTestTree trivialFold + { foldSingle = const $ const . (: []) . (, []) + , foldGroup = const $ map . first . flip (++) . (++ ".") + , foldAfter = const foldDeps + } + where + foldDeps AllSucceed (And (StringLit "tasty-bench") p) = + map $ second $ (++) $ findMatchingKeys im p + foldDeps _ _ = id + +findMatchingKeys :: IntMap (Seq TestName) -> Expr -> [IM.Key] +findMatchingKeys im pattern = + foldr (\(k, v) -> if withFields v pat == Right True then (k :) else id) [] $ IM.assocs im + where + pat = eval pattern >>= asB + +postprocessResult + :: (TestName -> Maybe Result -> Result -> Result) + -> IntMap (TestName, Maybe IM.Key, TVar Status) + -> IO StatusMap postprocessResult f src = do - paired <- forM src $ \(name, tv) -> (name, tv,) <$> newTVarIO NotStarted + paired <- forM src $ \(name, mDepId, tv) -> (name, mDepId, tv,) <$> newTVarIO NotStarted let doUpdate = atomically $ do (Any anyUpdated, All allDone) <- - getApp $ flip foldMap paired $ \(name, newTV, oldTV) -> Ap $ do + getApp $ flip foldMap paired $ \(name, mDepId, newTV, oldTV) -> Ap $ do old <- readTVar oldTV case old of Done{} -> pure (Any False, All True) @@ -1182,12 +1433,21 @@ new <- readTVar newTV case new of Done res -> do - writeTVar oldTV (Done (f name res)) + + depRes <- case mDepId >>= (`IM.lookup` src) of + Nothing -> pure Nothing + Just (_, _, depTV) -> do + depStatus <- readTVar depTV + case depStatus of + Done dep -> pure $ Just dep + _ -> pure Nothing + + writeTVar oldTV (Done (f name depRes res)) pure (Any True, All True) -- ignoring Progress nodes, we do not report any - -- it would be helpful to have instance Eq Status + -- it would be helpful to have instance Eq Progress _ -> pure (Any False, All False) if anyUpdated || allDone then pure allDone else retry adNauseam = doUpdate >>= (`unless` adNauseam) _ <- forkIO adNauseam - pure $ fmap (\(_, _, a) -> a) paired + pure $ fmap (\(_, _, _, a) -> a) paired diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,9 @@ +# 0.2.4 + +* Add a simplistic SVG reporter. +* Add `bcompare` to compare between benchmarks. +* Throw a warning, if benchmarks take too long. + # 0.2.3 * Prohibit duplicated benchmark names in CSV reports. diff --git a/example.svg b/example.svg new file mode 100644 --- /dev/null +++ b/example.svg @@ -0,0 +1,49 @@ + + + +Inversion.Data.Mod +353 ms + + +353 ms ± 47 ms + + + + + + +Inversion.Data.Mod.Word 294 ms + +294 ms ± 43 ms + + + + + + + +Inversion.finite-field +1.03 s + + +1.03 s ± 147 ms + + + + + + + +Inversion.modular-arithmetic +896 ms + + +896 ms ± 58 ms + + + + + + + + diff --git a/tasty-bench.cabal b/tasty-bench.cabal --- a/tasty-bench.cabal +++ b/tasty-bench.cabal @@ -1,6 +1,6 @@ name: tasty-bench -version: 0.2.3 -cabal-version: >=1.10 +version: 0.2.4 +cabal-version: 1.18 build-type: Simple license: MIT license-file: LICENSE @@ -14,12 +14,14 @@ Featherlight framework (only one file!) for performance measurement with API mimicking @criterion@ and @gauge@, featuring built-in comparison - against baseline. Our benchmarks are just + against previous runs and between benchmarks. Our benchmarks are just regular @tasty@ tests. extra-source-files: changelog.md README.md +extra-doc-files: + example.svg tested-with: GHC==9.0.1, GHC==8.10.4, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 @@ -32,6 +34,8 @@ hs-source-dirs: . default-language: Haskell2010 ghc-options: -O2 -Wall -fno-warn-unused-imports + if impl(ghc < 7.10) + ghc-options: -fcontext-stack=30 build-depends: base >= 4.3 && < 5,