diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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`. -![Plotting](./example.svg) +## 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` diff --git a/Test/Tasty/Bench.hs b/Test/Tasty/Bench.hs --- a/Test/Tasty/Bench.hs +++ b/Test/Tasty/Bench.hs @@ -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 here. +an 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 @@ ![Plotting](example.svg) +=== 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 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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. diff --git a/tasty-bench.cabal b/tasty-bench.cabal --- a/tasty-bench.cabal +++ b/tasty-bench.cabal @@ -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