tasty-bench 0.3 → 0.3.1
raw patch · 4 files changed
+300/−100 lines, 4 files
Files
- README.md +37/−7
- Test/Tasty/Bench.hs +235/−88
- changelog.md +5/−0
- tasty-bench.cabal +23/−5
README.md view
@@ -168,7 +168,7 @@ instead of wall-clock time. It does not provide a perfect isolation from other processes (e. g., if CPU cache is spoiled by others, populating data back from RAM-is your burden), but is significantly more stable.+is your burden), but is a bit more stable. Caveat: this means that for multithreaded algorithms `tasty-bench` reports total elapsed CPU time across all cores, while@@ -325,7 +325,7 @@ Unhandled resource. Probably a bug in the runner you're using. ``` -or+ or ``` Unexpected state of the resource (NotCreated) in getResource. Report as a tasty bug.@@ -336,6 +336,11 @@ or affect their hierarchy in other way. This is a fundamental restriction of `tasty` to list and filter benchmarks without launching missiles. +* If benchmarks fail with `Test dependencies form a loop`, this is likely+ because of `bcompare`, which compares a benchmark with itself.+ Locating a benchmark in a global environment may be tricky, please refer to+ [`tasty` documentation](https://github.com/UnkindPartition/tasty#patterns) for details.+ ## Isolating interfering benchmarks One difficulty of benchmarking in Haskell is that it is@@ -392,7 +397,7 @@ ```bash cabal build --enable-benchmarks my-bench-MYBENCH=$(cabal list-bin my-bench)+MYBENCH=$(cabal list-bin my-bench) # available since cabal-3.4 ``` Now list all benchmark names (hopefully, they do not contain newlines),@@ -441,6 +446,12 @@ [`tasty-rerun`](http://hackage.haskell.org/package/tasty-rerun) package to focus on rerunning failing items only. +If you wish to compare two CSV reports non-interactively, here is a handy `awk` incantation:++```sh+awk 'BEGIN{FS=",";OFS=",";print "Name,Old,New,Ratio"}FNR==1{next}FNR==NR{a[$1]=$2;next}{print $1,a[$1],$2,$2/a[$1];gs+=log($2/a[$1]);gc++}END{print "Geometric mean,,",exp(gs/gc)}' old.csv new.csv+```+ Note that columns in CSV report are different from what `criterion` or `gauge` would produce. If names do not contain commas, missing columns can be faked this way: @@ -504,17 +515,36 @@ ``` is a more robust choice of-an [`awk` pattern](https://github.com/feuerbach/tasty#patterns) here.+an [`awk` pattern](https://github.com/UnkindPartition/tasty#patterns) here. +One can leverage comparisons between benchmarks to implement portable performance+tests, expressing properties like "this algorithm must be at least twice faster+than that one" or "this operation should not be more than thrice slower than that".+This can be achieved with `bcompareWithin`, which takes an acceptable interval+of performance as an argument.+ ## 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:+which can be invoked by passing `--svg FILE`. -+## Build flags +Build flags are a brittle subject and users do not normally need to touch them.++* If you find yourself in an environment, where `tasty` is not available and you+ have access to boot packages only, you can still use `tasty-bench`! Just copy+ `Test/Tasty/Bench.hs` to your project (imagine it like a header-only C library).+ It will provide you with functions to build `Benchmarkable` and run them manually+ via `measureCpuTime`. This mode of operation can be also configured+ by disabling Cabal flag `tasty`.++* If results are amiss or oscillate wildly and adjusting `--timeout` and `--stdev`+ does not help, you may be interested to investigate individual timings of+ successive runs by enabling Cabal flag `debug`. This will pipe raw data into `stderr`.+ ## Command-line options Use `--help` to list command-line options.@@ -523,7 +553,7 @@ This is a standard `tasty` option, which allows filtering benchmarks by a pattern or `awk` expression. Please refer to- [`tasty` documentation](https://github.com/feuerbach/tasty#patterns)+ [`tasty` documentation](https://github.com/UnkindPartition/tasty#patterns) for details. * `-t`, `--timeout`
Test/Tasty/Bench.hs view
@@ -163,7 +163,7 @@ instead of wall-clock time. It does not provide a perfect isolation from other processes (e. g., if CPU cache is spoiled by others, populating data back from RAM-is your burden), but is significantly more stable.+is your burden), but is a bit more stable. Caveat: this means that for multithreaded algorithms @tasty-bench@ reports total elapsed CPU time across all cores, while@@ -319,6 +319,11 @@ way. This is a fundamental restriction of @tasty@ to list and filter benchmarks without launching missiles. +- If benchmarks fail with @Test dependencies form a loop@, this is likely+ because of 'bcompare', which compares a benchmark with itself.+ Locating a benchmark in a global environment may be tricky, please refer to+ [@tasty@ documentation](https://github.com/UnkindPartition/tasty#patterns) for details.+ === Isolating interfering benchmarks One difficulty of benchmarking in Haskell is that it is hard to isolate@@ -370,7 +375,7 @@ @benchmark@ @my-bench@ component, let’s first find its executable: > cabal build --enable-benchmarks my-bench-> MYBENCH=$(cabal list-bin my-bench)+> MYBENCH=$(cabal list-bin my-bench) # available since cabal-3.4 Now list all benchmark names (hopefully, they do not contain newlines), escape quotes and slashes, and run each of them separately:@@ -412,6 +417,10 @@ even [@tasty-rerun@](http://hackage.haskell.org/package/tasty-rerun) package to focus on rerunning failing items only. +If you wish to compare two CSV reports non-interactively, here is a handy @awk@ incantation:++> awk 'BEGIN{FS=",";OFS=",";print "Name,Old,New,Ratio"}FNR==1{next}FNR==NR{a[$1]=$2;next}{print $1,a[$1],$2,$2/a[$1];gs+=log($2/a[$1]);gc++}END{print "Geometric mean,,",exp(gs/gc)}' old.csv new.csv+ Note that columns in CSV report are different from what @criterion@ or @gauge@ would produce. If names do not contain commas, missing columns can be faked this way: @@ -461,8 +470,14 @@ > bcompare "$NF == \"tenth\" && $(NF-1) == \"fibonacci numbers\"" is a more robust choice of-an <https://github.com/feuerbach/tasty#patterns awk pattern> here.+an <https://github.com/UnkindPartition/tasty#patterns awk pattern> here. +One can leverage comparisons between benchmarks to implement portable performance+tests, expressing properties like "this algorithm must be at least twice faster+than that one" or "this operation should not be more than thrice slower than that".+This can be achieved with 'bcompareWithin', which takes an acceptable interval+of performance as an argument.+ === Plotting results Users can dump results into CSV with @--csv@ @FILE@ and plot them using@@ -472,6 +487,21 @@  +=== Build flags++Build flags are a brittle subject and users do not normally need to touch them.++* If you find yourself in an environment, where @tasty@ is not available and you+ have access to boot packages only, you can still use @tasty-bench@! Just copy+ @Test\/Tasty\/Bench.hs@ to your project (imagine it like a header-only C library).+ It will provide you with functions to build 'Benchmarkable' and run them manually+ via 'measureCpuTime'. This mode of operation can be also configured+ by disabling Cabal flag @tasty@.++* If results are amiss or oscillate wildly and adjusting @--timeout@ and @--stdev@+ does not help, you may be interested to investigate individual timings of+ successive runs by enabling Cabal flag @debug@. This will pipe raw data into @stderr@.+ === Command-line options Use @--help@ to list command-line options.@@ -480,7 +510,7 @@ This is a standard @tasty@ option, which allows filtering benchmarks by a pattern or @awk@ expression. Please refer- to [@tasty@ documentation](https://github.com/feuerbach/tasty#patterns)+ to [@tasty@ documentation](https://github.com/UnkindPartition/tasty#patterns) for details. [@-t@, @--timeout@]:@@ -565,6 +595,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -572,6 +603,7 @@ module Test.Tasty.Bench (+#ifdef MIN_VERSION_tasty -- * Running 'Benchmark' defaultMain , Benchmark@@ -579,11 +611,14 @@ , bgroup #if MIN_VERSION_tasty(1,2,0) , bcompare+ , bcompareWithin #endif , env , envWithCleanup+ ,+#endif -- * Creating 'Benchmarkable'- , Benchmarkable(..)+ Benchmarkable(..) , nf , whnf , nfIO@@ -591,6 +626,7 @@ , nfAppIO , whnfAppIO , measureCpuTime+#ifdef MIN_VERSION_tasty -- * Ingredients , benchIngredients , consoleBenchReporter@@ -602,9 +638,14 @@ , CsvPath(..) , BaselinePath(..) , SvgPath(..)+#else+ , Timeout(..)+ , RelStDev(..)+#endif ) where import Prelude hiding (Int, Integer)+import qualified Prelude import Control.Applicative import Control.Arrow (first, second) import Control.DeepSeq (NFData, force)@@ -613,27 +654,46 @@ import Data.Data (Typeable) import Data.Foldable (foldMap, traverse_) import Data.Int (Int64)-import Data.IntMap (IntMap)-#if MIN_VERSION_containers(0,5,0)-import qualified Data.IntMap.Strict as IM-#else-import qualified Data.IntMap as IM-#endif import Data.IORef import Data.List (intercalate, stripPrefix, isPrefixOf, genericLength, genericDrop) import Data.Monoid (All(..), Any(..)) import Data.Proxy-import Data.Sequence (Seq, (<|))-import qualified Data.Sequence as Seq-import qualified Data.Set as S import Data.Traversable (forM) import Data.Word (Word64) import GHC.Conc+#if MIN_VERSION_base(4,5,0)+import GHC.IO.Encoding+#endif #if MIN_VERSION_base(4,6,0) import GHC.Stats #endif import System.CPUTime+import System.Exit+import System.IO+import System.IO.Unsafe import System.Mem+import Text.Printf++#ifdef DEBUG+import Debug.Trace+#endif++#ifdef MIN_VERSION_tasty+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (Monoid(..))+#endif+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup(..))+#endif+#if MIN_VERSION_containers(0,5,0)+import qualified Data.IntMap.Strict as IM+#else+import qualified Data.IntMap as IM+#endif+import Data.IntMap (IntMap)+import Data.Sequence (Seq, (<|))+import qualified Data.Sequence as Seq+import qualified Data.Set as S import Test.Tasty hiding (defaultMain) import qualified Test.Tasty import Test.Tasty.Ingredients@@ -645,11 +705,18 @@ #endif import Test.Tasty.Providers import Test.Tasty.Runners-import Text.Printf-import System.Exit-import System.IO-import System.IO.Unsafe+#endif +#ifndef MIN_VERSION_tasty+data Timeout+ = Timeout+ Prelude.Integer -- ^ number of microseconds (e. g., 200000)+ String -- ^ textual representation (e. g., @"0.2s"@)+ | NoTimeout+ deriving (Show)+#endif++ -- | In addition to @--stdev@ command-line option, -- one can adjust target relative standard deviation -- for individual benchmarks and groups of benchmarks@@ -670,6 +737,7 @@ newtype RelStDev = RelStDev Double deriving (Show, Read, Typeable) +#ifdef MIN_VERSION_tasty instance IsOption RelStDev where defaultValue = RelStDev 0.05 parseValue = fmap RelStDev . parsePositivePercents@@ -721,6 +789,7 @@ x <- safeRead xs guard (x > 0) pure (x / 100)+#endif -- | Something that can be benchmarked, produced by 'nf', 'whnf', 'nfIO', 'whnfIO', -- 'nfAppIO', 'whnfAppIO' below.@@ -731,6 +800,8 @@ { unBenchmarkable :: Word64 -> IO () -- ^ Run benchmark given number of times. } deriving (Typeable) +#ifdef MIN_VERSION_tasty+ -- | Show picoseconds, fitting number in 3 characters. showPicos3 :: Word64 -> String showPicos3 i@@ -779,6 +850,7 @@ | otherwise = printf "%3.0f EB" (t / 1152921504606846976) where t = word64ToDouble i+#endif data Measurement = Measurement { measTime :: !Word64 -- ^ time in picoseconds@@ -792,12 +864,14 @@ , estStdev :: !Word64 -- ^ stdev in picoseconds } deriving (Show, Read) -data Response = Response- { respEstimate :: !Estimate- , respIfSlower :: !FailIfSlower -- ^ saved value of --fail-if-slower- , respIfFaster :: !FailIfFaster -- ^ saved value of --fail-if-faster- } deriving (Show, Read)+#ifdef MIN_VERSION_tasty +data WithLoHi a = WithLoHi+ !a -- payload+ !Double -- lower bound (e. g., 0.9 for -10% speedup)+ !Double -- upper bound (e. g., 1.2 for +20% slowdown)+ deriving (Show, Read)+ prettyEstimate :: Estimate -> String prettyEstimate (Estimate m stdev) = showPicos4 (measTime m)@@ -817,6 +891,7 @@ csvEstimateWithGC :: Estimate -> String csvEstimateWithGC (Estimate m stdev) = show (measTime m) ++ "," ++ show (2 * stdev) ++ "," ++ show (measAllocs m) ++ "," ++ show (measCopied m) ++ "," ++ show (measMaxMem m)+#endif predict :: Measurement -- ^ time for one run@@ -873,12 +948,17 @@ act n endTime <- fromInteger <$> getCPUTime (endAllocs, endCopied, endMaxMemInUse) <- getAllocsAndCopied- pure $ Measurement- { measTime = endTime - startTime- , measAllocs = endAllocs - startAllocs- , measCopied = endCopied - startCopied- , measMaxMem = max endMaxMemInUse startMaxMemInUse- }+ let meas = Measurement+ { measTime = endTime - startTime+ , measAllocs = endAllocs - startAllocs+ , measCopied = endCopied - startCopied+ , measMaxMem = max endMaxMemInUse startMaxMemInUse+ }+#ifdef DEBUG+ pure $ trace (show n ++ (if n == 1 then " iteration gives " else " iterations give ") ++ show meas) meas+#else+ pure meas+#endif measureUntil :: Bool -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate measureUntil _ _ (RelStDev targetRelStDev) b@@ -927,6 +1007,8 @@ = ((fmap ((/ 1e12) . word64ToDouble . measTime . estMean) .) .) . measureUntil False +#ifdef MIN_VERSION_tasty+ instance IsTest Benchmarkable where testOptions = pure [ Option (Proxy :: Proxy RelStDev)@@ -938,7 +1020,9 @@ run opts b = const $ case getNumThreads (lookupOption opts) of 1 -> do est <- measureUntil True (lookupOption opts) (lookupOption opts) b- pure $ testPassed $ show (Response est (lookupOption opts) (lookupOption opts))+ let FailIfSlower ifSlower = lookupOption opts+ FailIfFaster ifFaster = lookupOption opts+ pure $ testPassed $ show (WithLoHi est (1 - ifFaster) (1 + ifSlower)) _ -> pure $ testFailed "Benchmarks must not be run concurrently. Please pass -j1 and/or avoid +RTS -N." -- | Attach a name to 'Benchmarkable'.@@ -961,23 +1045,44 @@ #if MIN_VERSION_tasty(1,2,0) -- | 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' and requires @tasty-1.2@. ---bcompare :: String -> Benchmark -> Benchmark-bcompare s = case parseExpr s of+bcompare+ :: String+ -- ^ @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/UnkindPartition/tasty#patterns) for details.+ -> Benchmark+ -- ^ Benchmark (or a group of benchmarks)+ -- to be compared against the baseline benchmark by dividing measured mean times.+ -- The result is reported by 'consoleBenchReporter', e. g., 0.50x or 1.25x.+ -> Benchmark+bcompare = bcompareWithin (-1/0) (1/0)++-- | Same as 'bcompare', but takes expected lower and upper bounds of+-- comparison. If the result is not within provided bounds, benchmark is failed.+-- This allows to create portable performance tests: instead of comparing+-- to an absolute timeout or to previous runs, you can state that one implementation+-- of an algorithm must be faster than another.+--+-- E. g., 'bcompareWithin' 2.0 3.0 passes only if a benchmark is at least 2x+-- and at most 3x slower than a baseline.+--+bcompareWithin+ :: Double -- ^ Lower bound of relative speed up.+ -> Double -- ^ Upper bound of relative spped up.+ -> String -- ^ @tasty@ pattern to locate a baseline benchmark.+ -> Benchmark -- ^ Benchmark to compare against baseline.+ -> Benchmark+bcompareWithin lo hi s = case parseExpr s of Nothing -> error $ "Could not parse bcompare pattern " ++ s- Just e -> after_ AllSucceed (And (StringLit "tasty-bench") e)+ Just e -> after_ AllSucceed (And (StringLit (bcomparePrefix ++ show (lo, hi))) e)++bcomparePrefix :: String+bcomparePrefix = "tasty-bench" #endif -- | Benchmarks are actually just a regular 'Test.Tasty.TestTree' in disguise.@@ -991,13 +1096,19 @@ -- and 'Gauge.defaultMain'. -- defaultMain :: [Benchmark] -> IO ()-defaultMain = Test.Tasty.defaultMainWithIngredients benchIngredients . testGroup "All"+defaultMain bs = do+#if MIN_VERSION_base(4,5,0)+ setLocaleEncoding utf8+#endif+ Test.Tasty.defaultMainWithIngredients benchIngredients $ testGroup "All" bs -- | List of default benchmark ingredients. This is what 'defaultMain' runs. -- benchIngredients :: [Ingredient] benchIngredients = [listingTests, composeReporters consoleBenchReporter (composeReporters csvReporter svgReporter)] +#endif+ funcToBench :: (b -> c) -> (a -> b) -> a -> Benchmarkable funcToBench frc = (Benchmarkable .) . go where@@ -1014,13 +1125,13 @@ -- Ideally @x@ should be a primitive data type like 'Data.Int.Int'. -- -- The same thunk of @x@ is shared by multiple calls of @f@. We cannot evaluate--- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentialy @x@ may+-- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentially @x@ may -- be an infinite structure. Thus @x@ will be evaluated in course of the first -- application of @f@. This noisy measurement is to be discarded soon, -- but if @x@ is not a primitive data type, consider forcing its evaluation -- separately, e. g., via 'env' or 'withResource'. ----- Here is a textbook antipattern: 'nf' 'sum' @[1..1000000]@.+-- Here is a textbook anti-pattern: 'nf' 'sum' @[1..1000000]@. -- Since an input list is shared by multiple invocations of 'sum', -- it will be allocated in memory in full, putting immense pressure -- on garbage collector. Also no list fusion will happen.@@ -1053,7 +1164,7 @@ -- Ideally @x@ should be a primitive data type like 'Data.Int.Int'. -- -- The same thunk of @x@ is shared by multiple calls of @f@. We cannot evaluate--- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentialy @x@ may+-- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentially @x@ may -- be an infinite structure. Thus @x@ will be evaluated in course of the first -- application of @f@. This noisy measurement is to be discarded soon, -- but if @x@ is not a primitive data type, consider forcing its evaluation@@ -1066,7 +1177,7 @@ -- Unless you understand precisely, what is measured, -- it is recommended to use 'nf' instead. ----- Here is a textbook antipattern: 'whnf' ('Data.List.replicate' @1000000@) @1@.+-- Here is a textbook anti-pattern: 'whnf' ('Data.List.replicate' @1000000@) @1@. -- This will succeed in a matter of nanoseconds, because weak head -- normal form forces only the first element of the list. --@@ -1153,7 +1264,7 @@ -- Ideally @x@ should be a primitive data type like 'Data.Int.Int'. -- -- The same thunk of @x@ is shared by multiple calls of @f@. We cannot evaluate--- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentialy @x@ may+-- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentially @x@ may -- be an infinite structure. Thus @x@ will be evaluated in course of the first -- application of @f@. This noisy measurement is to be discarded soon, -- but if @x@ is not a primitive data type, consider forcing its evaluation@@ -1182,7 +1293,7 @@ -- Ideally @x@ should be a primitive data type like 'Data.Int.Int'. -- -- The same thunk of @x@ is shared by multiple calls of @f@. We cannot evaluate--- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentialy @x@ may+-- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentially @x@ may -- be an infinite structure. Thus @x@ will be evaluated in course of the first -- application of @f@. This noisy measurement is to be discarded soon, -- but if @x@ is not a primitive data type, consider forcing its evaluation@@ -1204,6 +1315,8 @@ whnfAppIO = ioFuncToBench id {-# INLINE whnfAppIO #-} +#ifdef MIN_VERSION_tasty+ -- | Run benchmarks in the given environment, usually reading large input data from file. -- -- One might wonder why 'env' is needed,@@ -1337,7 +1450,7 @@ r <- atomically $ readTVar tv >>= \s -> case s of Done r -> pure r; _ -> retry case safeRead (resultDescription r) of Nothing -> pure ()- Just (Response est _ _) -> do+ Just (WithLoHi est _ _) -> do msg <- formatMessage $ csv est hPutStrLn h (encodeCsv name ++ ',' : msg) @@ -1395,7 +1508,7 @@ 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) :)+ Just (WithLoHi est _ _) -> modifyIORef ref ((name, est) :) svgRender :: [(TestName, Estimate)] -> String svgRender [] = ""@@ -1511,19 +1624,23 @@ Nothing -> pure S.empty Just (BaselinePath path) -> S.fromList . joinQuotedFields . lines <$> (readFile path >>= evaluate . force) let pretty = if hasGCStats then prettyEstimateWithGC else prettyEstimate- pure $ \name depR r -> case safeRead (resultDescription r) of+ pure $ \name mDepR r -> case safeRead (resultDescription r) of Nothing -> r- Just (Response est (FailIfSlower ifSlow) (FailIfFaster ifFast)) ->+ Just (WithLoHi est lowerBound upperBound) -> (if isAcceptable then id else forceFail)- r { resultDescription = pretty est ++ bcomp ++ formatSlowDown slowDown }+ r { resultDescription = pretty est ++ bcompareMsg ++ formatSlowDown slowDown } where+ isAcceptable = isAcceptableVsBaseline && isAcceptableVsBcompare slowDown = compareVsBaseline baseline name est- isAcceptable -- ifSlow/ifFast may be infinite, so we cannot 'truncate'- = int64ToDouble slowDown <= 100 * ifSlow- && int64ToDouble slowDown >= -100 * ifFast- bcomp = case depR >>= safeRead . resultDescription of- Nothing -> ""- Just (Response depEst _ _) -> printf ", %.2fx" (estTime est / estTime depEst)+ isAcceptableVsBaseline = slowDown >= lowerBound && slowDown <= upperBound+ (isAcceptableVsBcompare, bcompareMsg) = case mDepR of+ Nothing -> (True, "")+ Just (WithLoHi depR depLowerBound depUpperBound) -> case safeRead (resultDescription depR) of+ Nothing -> (True, "")+ Just (WithLoHi depEst _ _) -> let ratio = estTime est / estTime depEst in+ ( ratio >= depLowerBound && ratio <= depUpperBound+ , printf ", %.2fx" ratio+ ) -- | A well-formed CSV entry contains an even number of quotes: 0, 2 or more. joinQuotedFields :: [String] -> [String]@@ -1539,14 +1656,13 @@ estTime :: Estimate -> Double estTime = word64ToDouble . measTime . estMean --- | Return slow down in percents.-compareVsBaseline :: S.Set String -> TestName -> Estimate -> Int64+compareVsBaseline :: S.Set String -> TestName -> Estimate -> Double compareVsBaseline baseline name (Estimate m stdev) = case mOld of- Nothing -> 0+ Nothing -> 1 Just (oldTime, oldDoubleSigma) -- time and oldTime must be signed integers to use 'abs'- | abs (time - oldTime) < max (2 * word64ToInt64 stdev) oldDoubleSigma -> 0- | otherwise -> 100 * (time - oldTime) `quot` oldTime+ | abs (time - oldTime) < max (2 * word64ToInt64 stdev) oldDoubleSigma -> 1+ | otherwise -> int64ToDouble time / int64ToDouble oldTime where time = word64ToInt64 $ measTime m @@ -1567,18 +1683,42 @@ let doubleSigmaCell = takeWhile (/= ',') rest (,) <$> safeRead timeCell <*> safeRead doubleSigmaCell -formatSlowDown :: Int64 -> String-formatSlowDown n = case n `compare` 0 of- LT -> printf ", %2i%% faster than baseline" (-n)+formatSlowDown :: Double -> String+formatSlowDown n = case m `compare` 0 of+ LT -> printf ", %2i%% faster than baseline" (-m) EQ -> ""- GT -> printf ", %2i%% slower than baseline" n+ GT -> printf ", %2i%% slower than baseline" m+ where+ m :: Int64+ m = truncate ((n - 1) * 100) forceFail :: Result -> Result forceFail r = r { resultOutcome = Failure TestFailed, resultShortDescription = "FAIL" } +data Unique a = None | Unique !a | NotUnique+ deriving (Functor)++appendUnique :: Unique a -> Unique a -> Unique a+appendUnique None a = a+appendUnique a None = a+appendUnique _ _ = NotUnique++#if MIN_VERSION_base(4,9,0)+instance Semigroup (Unique a) where+ (<>) = appendUnique+#endif++instance Monoid (Unique a) where+ mempty = None+#if MIN_VERSION_base(4,9,0)+ mappend = (<>)+#else+ mappend = appendUnique+#endif+ modifyConsoleReporter :: [OptionDescription]- -> (OptionSet -> IO (TestName -> Maybe Result -> Result -> Result))+ -> (OptionSet -> IO (TestName -> Maybe (WithLoHi Result) -> Result -> Result)) -> Ingredient modifyConsoleReporter desc' iof = TestReporter (desc ++ desc') $ \opts tree -> let nameSeqs = IM.fromDistinctAscList $ zip [0..] $ testNameSeqs opts tree@@ -1592,7 +1732,7 @@ TestReporter d c -> (d, c) _ -> error "modifyConsoleReporter: consoleTestReporter must be TestReporter" - isSingle [a] = Just a+ isSingle (Unique a) = Just a isSingle _ = Nothing testNameSeqs :: OptionSet -> TestTree -> [Seq TestName]@@ -1605,9 +1745,9 @@ #endif } -testNamesAndDeps :: IntMap (Seq TestName) -> OptionSet -> TestTree -> [(TestName, [IM.Key])]+testNamesAndDeps :: IntMap (Seq TestName) -> OptionSet -> TestTree -> [(TestName, Unique (WithLoHi IM.Key))] testNamesAndDeps im = foldTestTree trivialFold- { foldSingle = const $ const . (: []) . (, [])+ { foldSingle = const $ const . (: []) . (, mempty) #if MIN_VERSION_tasty(1,4,0) , foldGroup = const $ map . first . (++) . (++ ".") , foldAfter = const foldDeps@@ -1620,20 +1760,23 @@ } #if MIN_VERSION_tasty(1,2,0) where- foldDeps AllSucceed (And (StringLit "tasty-bench") p) =- map $ second $ (++) $ findMatchingKeys im p+ foldDeps :: DependencyType -> Expr -> [(a, Unique (WithLoHi IM.Key))] -> [(a, Unique (WithLoHi IM.Key))]+ foldDeps AllSucceed (And (StringLit xs) p)+ | bcomparePrefix `isPrefixOf` xs+ , Just (lo :: Double, hi :: Double) <- safeRead $ drop (length bcomparePrefix) xs+ = map $ second $ mappend $ (\x -> WithLoHi x lo hi) <$> findMatchingKeys im p foldDeps _ _ = id -findMatchingKeys :: IntMap (Seq TestName) -> Expr -> [IM.Key]+findMatchingKeys :: IntMap (Seq TestName) -> Expr -> Unique IM.Key findMatchingKeys im pattern =- foldr (\(k, v) -> if withFields v pat == Right True then (k :) else id) [] $ IM.assocs im+ foldMap (\(k, v) -> if withFields v pat == Right True then Unique k else mempty) $ IM.assocs im where pat = eval pattern >>= asB #endif postprocessResult- :: (TestName -> Maybe Result -> Result -> Result)- -> IntMap (TestName, Maybe IM.Key, TVar Status)+ :: (TestName -> Maybe (WithLoHi Result) -> Result -> Result)+ -> IntMap (TestName, Maybe (WithLoHi IM.Key), TVar Status) -> IO StatusMap postprocessResult f src = do paired <- forM src $ \(name, mDepId, tv) -> (name, mDepId, tv,) <$> newTVarIO NotStarted@@ -1648,13 +1791,15 @@ case new of Done res -> do - depRes <- case mDepId >>= (`IM.lookup` src) of+ depRes <- case mDepId of Nothing -> pure Nothing- Just (_, _, depTV) -> do- depStatus <- readTVar depTV- case depStatus of- Done dep -> pure $ Just dep- _ -> pure Nothing+ Just (WithLoHi depId lo hi) -> case IM.lookup depId src of+ Nothing -> pure Nothing+ Just (_, _, depTV) -> do+ depStatus <- readTVar depTV+ case depStatus of+ Done dep -> pure $ Just (WithLoHi dep lo hi)+ _ -> pure Nothing writeTVar oldTV (Done (f name depRes res)) pure (Any True, All True)@@ -1666,14 +1811,16 @@ _ <- forkIO adNauseam pure $ fmap (\(_, _, _, a) -> a) paired -word64ToDouble :: Word64 -> Double-word64ToDouble = fromIntegral- int64ToDouble :: Int64 -> Double int64ToDouble = fromIntegral word64ToInt64 :: Word64 -> Int64 word64ToInt64 = fromIntegral++#endif++word64ToDouble :: Word64 -> Double+word64ToDouble = fromIntegral #if !MIN_VERSION_base(4,10,0) && MIN_VERSION_base(4,6,0) int64ToWord64 :: Int64 -> Word64
changelog.md view
@@ -1,3 +1,8 @@+# 0.3.1++* Add `bcompareWithin` for portable performance tests.+* Add `tasty` and `debug` build flags.+ # 0.3 * Report mean time with 3 significant digits.
tasty-bench.cabal view
@@ -1,5 +1,5 @@ name: tasty-bench-version: 0.3+version: 0.3.1 cabal-version: 1.18 build-type: Simple license: MIT@@ -24,12 +24,25 @@ 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+tested-with: GHC == 9.2.1, GHC==9.0.1, GHC==8.10.7, 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 source-repository head type: git location: https://github.com/Bodigrim/tasty-bench +flag tasty+ default: True+ manual: True+ description:+ When disabled, reduces API to functions independent of @tasty@: combinators+ to construct @Benchmarkable@ and @measureCpuTime@.++flag debug+ default: False+ manual: True+ description:+ Emit ongoing diagnostic information for benchmarks.+ library exposed-modules: Test.Tasty.Bench hs-source-dirs: .@@ -42,9 +55,14 @@ build-depends: base >= 4.3 && < 5,- containers >= 0.4,- deepseq >= 1.1,- tasty >= 0.11.3+ deepseq >= 1.1+ if flag(tasty)+ build-depends:+ containers >= 0.4,+ tasty >= 0.11.3 if impl(ghc < 7.8) build-depends: tagged >= 0.2++ if flag(debug)+ cpp-options: -DDEBUG