gauge 0.2.1 → 0.2.2
raw patch · 10 files changed
+218/−205 lines, 10 filesdep +foundationdep −HUnitdep −tastydep −tasty-hunitdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: foundation
Dependencies removed: HUnit, tasty, tasty-hunit
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Gauge/Benchmark.hs +15/−5
- Gauge/Main.hs +45/−21
- Gauge/Main/Options.hs +22/−7
- Gauge/Measurement.hs +27/−16
- Gauge/Optional.hs +3/−3
- Gauge/Source/GC.hs +20/−9
- changelog.md +7/−0
- gauge.cabal +6/−57
- tests/Cleanup.hs +29/−30
- tests/Sanity.hs +44/−57
Gauge/Benchmark.hs view
@@ -70,7 +70,10 @@ import Data.List (unfoldr) import Gauge.IO.Printf (note, prolix) import Gauge.Main.Options (Config(..), Verbosity(..))-import Gauge.Measurement (measure, getTime, secs, Measured(..))+import Gauge.Measurement+ (measure, getTime, secs, Measured(..), defaultMinSamplesNormal,+ defaultMinSamplesQuick, defaultTimeLimitNormal,+ defaultTimeLimitQuick) import Gauge.Monad (Gauge, finallyGauge, askConfig, gaugeIO) import Gauge.Time (MilliSeconds(..), milliSecondsToDouble, microSecondsToDouble) import qualified Gauge.CSV as CSV@@ -552,8 +555,7 @@ let loop [] !_ _ = error "unpossible!" loop (iters:niters) iTotal acc = do endTime <- getTime- if length acc >= minSamples &&- endTime - start >= timeLimit+ if length acc >= minSamples && endTime - start >= timeLimit then do let !v = V.reverse (V.fromList acc) return (v, endTime - start, iTotal)@@ -579,10 +581,18 @@ ignoringIOErrors act = act `catch` (\e -> const (return ()) (e :: IOError)) bmTimeLimit :: Config -> Double-bmTimeLimit Config {..} = maybe (if quickMode then 0 else 5) id timeLimit+bmTimeLimit Config {..} =+ let def = if quickMode+ then defaultTimeLimitQuick+ else defaultTimeLimitNormal+ in maybe def id timeLimit bmMinSamples :: Config -> Int-bmMinSamples Config {..} = maybe (if quickMode then 1 else 10) id minSamples+bmMinSamples Config {..} =+ let def = if quickMode+ then defaultMinSamplesQuick+ else defaultMinSamplesNormal+ in maybe def id minSamples -- | Run a single benchmark measurement in a separate process. runBenchmarkIsolated :: Config -> String -> String -> IO (V.Vector Measured)
Gauge/Main.hs view
@@ -26,26 +26,26 @@ , module Gauge.Benchmark ) where -import Control.Applicative-import Control.Monad (unless, when)-#ifdef HAVE_ANALYSIS-import Gauge.Analysis (analyseBenchmark)+import Control.Applicative+import Control.Monad (unless, when) import qualified Gauge.CSV as CSV+#ifdef HAVE_ANALYSIS+import Gauge.Analysis (analyseBenchmark) #endif-import Gauge.IO.Printf (note, printError, rewindClearLine)-import Gauge.Benchmark-import Gauge.Main.Options-import Gauge.Measurement (Measured, measureAccessors_, rescale)-import Gauge.Monad (Gauge, askConfig, withConfig, gaugeIO)-import Data.List (sort)-import Data.Traversable-import System.Environment (getProgName, getArgs)-import System.Exit (ExitCode(..), exitWith)+import Gauge.IO.Printf (note, printError, rewindClearLine)+import Gauge.Benchmark+import Gauge.Main.Options+import Gauge.Measurement (Measured, measureAccessors_, rescale)+import Gauge.Monad (Gauge, askConfig, withConfig, gaugeIO)+import Data.List (sort)+import Data.Traversable+import System.Environment (getProgName, getArgs)+import System.Exit (ExitCode(..), exitWith) -- import System.FilePath.Glob-import System.IO (BufferMode(..), hSetBuffering, stdout)-import Basement.Terminal (initialize)+import System.IO (BufferMode(..), hSetBuffering, stdout)+import Basement.Terminal (initialize) import qualified Data.Vector as V-import Prelude -- Silence redundant import warnings+import Prelude -- Silence redundant import warnings -- | An entry point that can be used as a @main@ function. --@@ -85,10 +85,11 @@ quickAnalyse :: String -> V.Vector Measured -> Gauge () quickAnalyse desc meas = do Config{..} <- askConfig- let accessors =+ let timeAccessor = filter (("time" ==) . fst) measureAccessors_+ accessors = if verbosity == Verbose then measureAccessors_- else filter (("time" ==) . fst) measureAccessors_+ else timeAccessor _ <- note "%s%-40s " rewindClearLine desc if verbosity == Verbose then gaugeIO (putStrLn "") else return ()@@ -96,6 +97,10 @@ (\(k, (a, s, _)) -> reportStat a s k) accessors _ <- note "\n"++ _ <- traverse+ (\(_, (a, _, _)) -> writeToCSV csvFile a)+ timeAccessor pure () where@@ -105,6 +110,17 @@ let val = (accessor . rescale) $ V.last meas in maybe (return ()) (\x -> note "%-20s %-10s\n" msg (sh x)) val + writeToCSV file accessor =+ when (not $ V.null meas) $ do+ let val = (accessor . rescale) $ V.last meas+ case val of+ Nothing -> pure ()+ Just v ->+ gaugeIO $ CSV.write file $ CSV.Row+ [ CSV.string desc+ , CSV.float v+ ]+ -- | Run a benchmark interactively with supplied config, and analyse its -- performance. benchmarkWith :: Config -> Benchmarkable -> IO ()@@ -171,9 +187,17 @@ DefaultMode -> runDefault where runDefault = do- CSV.write (csvRawFile cfg) $ CSV.Row $ map (CSV.string . fst) measureAccessors_- CSV.write (csvFile cfg) $ CSV.Row $ map CSV.string- ["Name", "Mean","MeanLB","MeanUB","Stddev","StddevLB","StddevUB"]+ -- write the raw csv file header+ CSV.write (csvRawFile cfg) $ CSV.Row $ map CSV.string $+ ["name"] ++ map fst measureAccessors_++ -- write the csv file header+ CSV.write (csvFile cfg) $ CSV.Row $ map CSV.string $ ["Name"] +++ if quickMode cfg+ then ["Time"]+ -- This requires statistical analysis support. This must+ -- remain compatible with criterion.+ else ["Mean","MeanLB","MeanUB","Stddev","StddevLB","StddevUB"] hSetBuffering stdout NoBuffering selector <- selectBenches (match cfg) benches bsgroup
Gauge/Main/Options.hs view
@@ -26,8 +26,10 @@ -- Temporary: to support pre-AMP GHC 7.8.4: import Data.Monoid--import Gauge.Measurement (validateAccessors)+import Gauge.Measurement+ (validateAccessors, defaultMinSamplesNormal,+ defaultMinSamplesQuick, defaultTimeLimitNormal,+ defaultTimeLimitQuick) import Gauge.Time (MilliSeconds(..)) import Data.Char (isSpace, toLower) import Data.List (foldl')@@ -138,6 +140,9 @@ , displayMode :: DisplayMode } deriving (Eq, Read, Show, Typeable, Data, Generic) +defaultMinDuration :: MilliSeconds+defaultMinDuration = MilliSeconds 30+ -- | Default benchmarking configuration. defaultConfig :: Config defaultConfig = Config@@ -145,7 +150,7 @@ , forceGC = True , timeLimit = Nothing , minSamples = Nothing- , minDuration = MilliSeconds 30+ , minDuration = defaultMinDuration , includeFirstIter = False , quickMode = False , measureOnly = Nothing@@ -192,9 +197,17 @@ opts = [ Option "I" ["ci"] (ReqArg setCI "CI") "Confidence interval" , Option "G" ["no-gc"] (NoArg setNoGC) "Do not collect garbage between iterations"- , Option "L" ["time-limit"] (ReqArg setTimeLimit "SECS") "Time limit to run a benchmark, use 0 to force min-samples per benchmark"- , Option "" ["min-samples"] (ReqArg setMinSamples "COUNT") "Minimum number of samples to be taken"- , Option "" ["min-duration"] (ReqArg setMinDuration "MILLISECS") "Minimum duration of each sample, use 0 to force one iteration per sample"+ , Option "L" ["time-limit"] (ReqArg setTimeLimit "SECS") $+ "Min seconds for each benchmark run, default is "+ ++ show defaultTimeLimitNormal ++ " in normal mode, "+ ++ show defaultTimeLimitQuick ++ " in quick mode"+ , Option "" ["min-samples"] (ReqArg setMinSamples "COUNT") $+ "Min no. of samples for each benchmark, default is "+ ++ show defaultMinSamplesNormal ++ " in normal mode, "+ ++ show defaultMinSamplesQuick ++ " in quick mode"+ , Option "" ["min-duration"] (ReqArg setMinDuration "MILLISECS") $+ "Min duration for each sample, default is "+ ++ show defaultMinDuration ++ ", when 0 stops after first iteration" , Option "" ["include-first-iter"] (NoArg setIncludeFirst) "Do not discard the measurement of the first iteration" , Option "q" ["quick"] (NoArg setQuickMode) "Perform a quick measurement and report results without statistical analysis" , Option "" ["measure-only"] (fileArg setMeasureOnly) "Just measure the benchmark and place the raw data in the given file"@@ -210,7 +223,9 @@ , Option "v" ["verbosity"] (ReqArg setVerbosity "LEVEL") "Verbosity level" , Option "t" ["template"] (fileArg setTemplate) "Template to use for report" , Option "n" ["iters"] (ReqArg setIters "ITERS") "Run benchmarks, don't analyse"- , Option "m" ["match"] (ReqArg setMatch "MATCH") "How to match benchmark names: prefix, glob, pattern, or ipattern"+ , Option "m" ["match"] (ReqArg setMatch "MATCH") $+ "Benchmark match style: prefix, pattern (substring), "+ ++ "or ipattern (case insensitive)" , Option "l" ["list"] (NoArg $ setMode List) "List benchmarks" , Option "" ["version"] (NoArg $ setMode Version) "Show version info" , Option "s" ["small"] (NoArg $ setDisplayMode Condensed) "Set benchmark display to the minimum useful information"
Gauge/Measurement.hs view
@@ -22,8 +22,11 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} module Gauge.Measurement- (- initializeTime+ ( defaultMinSamplesNormal+ , defaultMinSamplesQuick+ , defaultTimeLimitNormal+ , defaultTimeLimitQuick+ , initializeTime , Time.getTime , Time.getCPUTime , Time.ClockTime(..)@@ -64,6 +67,14 @@ import qualified Gauge.Source.GC as GC import Prelude -- Silence redundant import warnings +defaultMinSamplesNormal, defaultMinSamplesQuick :: Int+defaultMinSamplesNormal = 10+defaultMinSamplesQuick = 1++defaultTimeLimitNormal, defaultTimeLimitQuick :: Double+defaultTimeLimitNormal = 5+defaultTimeLimitQuick = 0+ -- | A collection of measurements made while benchmarking. -- -- Measurements related to garbage collection are tagged with __GC__.@@ -438,13 +449,13 @@ -> Measured -> Measured applyGCStatistics (Just stats) m = m- { measAllocated = Optional.toOptional $ GC.allocated stats- , measNumGcs = Optional.toOptional $ GC.numGCs stats- , measBytesCopied = Optional.toOptional $ GC.copied stats- , measMutatorWallSeconds = Optional.toOptional $ nanoSecondsToDouble $ GC.mutWallSeconds stats- , measMutatorCpuSeconds = Optional.toOptional $ nanoSecondsToDouble $ GC.mutCpuSeconds stats- , measGcWallSeconds = Optional.toOptional $ nanoSecondsToDouble $ GC.gcWallSeconds stats- , measGcCpuSeconds = Optional.toOptional $ nanoSecondsToDouble $ GC.gcCpuSeconds stats+ { measAllocated = GC.allocated stats+ , measNumGcs = Optional.toOptional "num-gcs" $ GC.numGCs stats+ , measBytesCopied = GC.copied stats+ , measMutatorWallSeconds = Optional.toOptional "mut-wall-secs" $ nanoSecondsToDouble $ GC.mutWallSeconds stats+ , measMutatorCpuSeconds = Optional.toOptional "mut-cpu-secs" $ nanoSecondsToDouble $ GC.mutCpuSeconds stats+ , measGcWallSeconds = Optional.toOptional "gc-wall-secs" $ nanoSecondsToDouble $ GC.gcWallSeconds stats+ , measGcCpuSeconds = Optional.toOptional "gc-cpu-secs" $ nanoSecondsToDouble $ GC.gcCpuSeconds stats } applyGCStatistics Nothing m = m @@ -458,13 +469,13 @@ -- ^ Value to \"modify\". -> Measured applyRUStatistics end start m- | RUsage.supported = m { measUtime = Optional.toOptional $ diffTV RUsage.userCpuTime- , measStime = Optional.toOptional $ diffTV RUsage.systemCpuTime- , measMaxrss = Optional.toOptional $ RUsage.maxResidentSetSize end- , measMinflt = Optional.toOptional $ diff RUsage.minorFault- , measMajflt = Optional.toOptional $ diff RUsage.majorFault- , measNvcsw = Optional.toOptional $ diff RUsage.nVoluntaryContextSwitch- , measNivcsw = Optional.toOptional $ diff RUsage.nInvoluntaryContextSwitch+ | RUsage.supported = m { measUtime = Optional.toOptional "user-cpu-time" $ diffTV RUsage.userCpuTime+ , measStime = Optional.toOptional "system-cpu-time" $ diffTV RUsage.systemCpuTime+ , measMaxrss = Optional.toOptional "max-rss" $ RUsage.maxResidentSetSize end+ , measMinflt = Optional.toOptional "min-flt" $ diff RUsage.minorFault+ , measMajflt = Optional.toOptional "maj-flt" $ diff RUsage.majorFault+ , measNvcsw = Optional.toOptional "volontary-context-switch" $ diff RUsage.nVoluntaryContextSwitch+ , measNivcsw = Optional.toOptional "involontary-context-switch" $ diff RUsage.nInvoluntaryContextSwitch } | otherwise = m where diff f = f end - f start
Gauge/Optional.hs view
@@ -53,9 +53,9 @@ isOptionalTag d = isInfinite d || isNaN d -- | Create an optional value from a -toOptional :: (HasCallStack, OptionalTag a) => a -> Optional a-toOptional v- | isOptionalTag v = error "Creating an optional valid value using the optional tag"+toOptional :: (HasCallStack, OptionalTag a) => String -> a -> Optional a+toOptional ty v+ | isOptionalTag v = error ("Creating an optional valid value for " ++ ty ++ " using the optional tag") | otherwise = Optional v {-# INLINE toOptional #-}
Gauge/Source/GC.hs view
@@ -18,6 +18,7 @@ import Data.IORef (readIORef, newIORef, IORef) import Gauge.Time import System.IO.Unsafe (unsafePerformIO)+import Gauge.Optional (omitted, toOptional, Optional, OptionalTag) #if MIN_VERSION_base(4,10,0) import qualified GHC.Stats as GHC (RTSStats(..), getRTSStatsEnabled, getRTSStats)@@ -60,9 +61,9 @@ -- | Differential metrics related the RTS/GC data Metrics = Metrics- { allocated :: {-# UNPACK #-} !Word64 -- ^ number of bytes allocated+ { allocated :: {-# UNPACK #-} !(Optional Word64) -- ^ number of bytes allocated , numGCs :: {-# UNPACK #-} !Word64 -- ^ number of GCs- , copied :: {-# UNPACK #-} !Word64 -- ^ number of bytes copied+ , copied :: {-# UNPACK #-} !(Optional Word64) -- ^ number of bytes copied , mutWallSeconds :: {-# UNPACK #-} !NanoSeconds -- ^ mutator wall time measurement , mutCpuSeconds :: {-# UNPACK #-} !NanoSeconds -- ^ mutator cpu time measurement , gcWallSeconds :: {-# UNPACK #-} !NanoSeconds -- ^ gc wall time measurement@@ -72,13 +73,13 @@ diffMetrics :: AbsMetrics -> AbsMetrics -> Metrics diffMetrics (AbsMetrics end) (AbsMetrics start) = #if MIN_VERSION_base(4,10,0)- Metrics { allocated = diff (-*) GHC.allocated_bytes+ Metrics { allocated = diff (-*?) GHC.allocated_bytes , numGCs = diff (-*) (fromIntegral . GHC.gcs)- , copied = diff (-*) GHC.copied_bytes- , mutWallSeconds = NanoSeconds $ diff (-*) (fromIntegral . GHC.mutator_cpu_ns)+ , copied = diff (-*?) GHC.copied_bytes+ , mutWallSeconds = NanoSeconds $ diff (-*) (fromIntegral . GHC.mutator_elapsed_ns) , mutCpuSeconds = NanoSeconds $ diff (-*) (fromIntegral . GHC.mutator_cpu_ns)- , gcWallSeconds = NanoSeconds $ diff (-*) (fromIntegral . GHC.gc_cpu_ns)- , gcCpuSeconds = NanoSeconds $ diff (-*) (fromIntegral . GHC.gc_elapsed_ns)+ , gcWallSeconds = NanoSeconds $ diff (-*) (fromIntegral . GHC.gc_elapsed_ns)+ , gcCpuSeconds = NanoSeconds $ diff (-*) (fromIntegral . GHC.gc_cpu_ns) } where diff op f = f end `op` f start@@ -86,10 +87,15 @@ (-*) a b | a >= b = a - b | otherwise = (-1)++ (-*?) :: (OptionalTag a, Ord a, Num a) => a -> a -> Optional a+ (-*?) a b+ | a >= b = toOptional "gc metric" (a - b)+ | otherwise = omitted #else- Metrics { allocated = diff (-*) GHC.bytesAllocated+ Metrics { allocated = diff (-*?) GHC.bytesAllocated , numGCs = diff (-*) GHC.numGcs- , copied = diff (-*) GHC.bytesCopied+ , copied = diff (-*?) GHC.bytesCopied , mutWallSeconds = doubleToNanoSeconds $ diff (-) GHC.mutatorWallSeconds , mutCpuSeconds = doubleToNanoSeconds $ diff (-) GHC.mutatorCpuSeconds , gcWallSeconds = doubleToNanoSeconds $ diff (-) GHC.gcWallSeconds@@ -102,6 +108,11 @@ (-*) a b | a >= b = fromIntegral (a - b) | otherwise = (-1)++ (-*?) :: Int64 -> Int64 -> Optional Word64+ (-*?) a b+ | a >= b = toOptional "gc metrics" $ fromIntegral (a - b)+ | otherwise = omitted #endif -- | Return RTS/GC metrics differential between a call to `f`
changelog.md view
@@ -1,3 +1,10 @@+# 0.2.2++* Write data to CSV file in quick mode too.+* Fix the CSV file header to match with the data rows for the `--csvraw` case.+* Fix issue with GC metrics in 32 bits that would silently wrap and failure in optional machinery.+* Simplify dependencies in tests using foudation checks.+ # 0.2.1 * Inline math-functions & mwc-random:
gauge.cabal view
@@ -1,5 +1,5 @@ name: gauge-version: 0.2.1+version: 0.2.2 synopsis: small framework for performance measurement and analysis license: BSD3 license-file: LICENSE@@ -19,7 +19,8 @@ GHC==7.8.4, GHC==7.10.3, GHC==8.0.2,- GHC==8.2.2+ GHC==8.2.2,+ GHC==8.4.3 description: This library provides a powerful but simple way to measure software@@ -51,6 +52,7 @@ Gauge.Source.RUsage Gauge.Source.GC Gauge.Source.Time+ System.Random.MWC if flag(analysis) exposed-modules:@@ -76,7 +78,6 @@ Statistics.Transform Statistics.Types Statistics.Types.Internal- System.Random.MWC Numeric.MathFunctions.Comparison Numeric.MathFunctions.Constants Numeric.SpecFunctions@@ -121,60 +122,10 @@ ghc-options: -O2 -Wall -rtsopts build-depends:- HUnit, base, bytestring, gauge,- tasty,- tasty-hunit--test-suite verbose- type: exitcode-stdio-1.0- hs-source-dirs: tests- main-is: Sanity.hs- default-language: Haskell2010- ghc-options: -O2 -Wall -with-rtsopts "-T"- cpp-options: -DVERBOSE-- build-depends:- HUnit,- base,- bytestring,- gauge,- tasty,- tasty-hunit--test-suite quick- type: exitcode-stdio-1.0- hs-source-dirs: tests- main-is: Sanity.hs- default-language: Haskell2010- ghc-options: -O2 -Wall -with-rtsopts "-T"- cpp-options: -DQUICK-- build-depends:- HUnit,- base,- bytestring,- gauge,- tasty,- tasty-hunit--test-suite quick-verbose- type: exitcode-stdio-1.0- hs-source-dirs: tests- main-is: Sanity.hs- default-language: Haskell2010- ghc-options: -O2 -Wall -with-rtsopts "-T"- cpp-options: -DQUICK -DVERBOSE-- build-depends:- HUnit,- base,- bytestring,- gauge,- tasty,- tasty-hunit+ foundation test-suite cleanup type: exitcode-stdio-1.0@@ -186,14 +137,12 @@ -Wall -threaded -O0 -rtsopts build-depends:- HUnit, base, bytestring, gauge, deepseq, directory,- tasty,- tasty-hunit+ foundation benchmark self type: exitcode-stdio-1.0
tests/Cleanup.hs view
@@ -12,12 +12,11 @@ import Control.Monad (when) import Data.Typeable (Typeable) import System.Directory (doesFileExist, removeFile)-import System.Environment (withArgs) import System.IO ( Handle, IOMode(ReadWriteMode), SeekMode(AbsoluteSeek) , hClose, hFileSize, hSeek, openFile)-import Test.Tasty (TestTree, defaultMain, testGroup)-import Test.Tasty.HUnit (testCase)-import Test.HUnit (assertFailure)+import GHC.Exts (IsList(..))+import Foundation.Check+import Foundation.Check.Main import qualified Gauge as C import Data.ByteString (ByteString) import qualified Data.ByteString as BS@@ -26,7 +25,7 @@ instance NFData Handle where rnf !_ = () -data CheckResult = ShouldThrow | WrongData deriving (Show, Typeable)+data CheckResult = ShouldThrow | WrongData deriving (Show, Typeable, Eq) instance Exception CheckResult @@ -35,37 +34,40 @@ perRun :: BenchmarkWithFile perRun name alloc clean work =- bench name $ C.perRunEnvWithCleanup alloc clean work+ bench name $ C.perRunEnvWithCleanup alloc clean work perBatch :: BenchmarkWithFile perBatch name alloc clean work =- bench name $ C.perBatchEnvWithCleanup (const alloc) (const clean) work+ bench name $ C.perBatchEnvWithCleanup (const alloc) (const clean) work envWithCleanup :: BenchmarkWithFile envWithCleanup name alloc clean work =- C.envWithCleanup alloc clean $ bench name . nfIO . work+ C.envWithCleanup alloc clean $ bench name . nfIO . work -testCleanup :: Bool -> String -> BenchmarkWithFile -> TestTree-testCleanup shouldFail name withEnvClean = testCase name $ do- existsBefore <- doesFileExist testFile- when existsBefore $ failTest "Input file already exists"+testCleanup :: Bool -> String -> BenchmarkWithFile -> Test+testCleanup shouldFail name withEnvClean = CheckPlan (fromList name) $ do+ existsBefore <- pick "file-exists" $ doesFileExist testFile + validate "Temporary file not exists" $ existsBefore === False+ result <- runTest . withEnvClean name alloc clean $ \hnd -> do result <- hFileSize hnd >>= BS.hGet hnd . fromIntegral resetHandle hnd when (result /= testData) $ throwIO WrongData when shouldFail $ throwIO ShouldThrow - case result of- Left WrongData -> failTest "Incorrect result read from file"- Left ShouldThrow -> return ()- Right _ | shouldFail -> failTest "Failed to throw exception"- | otherwise -> return ()+ validate "is-right" $ case result of+ Left WrongData -> False -- failTest "Incorrect result read from file"+ Left ShouldThrow -> True+ Right _ | shouldFail -> False -- failTest "Failed to throw exception"+ | otherwise -> True - existsAfter <- doesFileExist testFile- when existsAfter $ do- removeFile testFile- failTest "Failed to delete file"+ failure <- pick "cleanup" $ do+ existsAfter <- doesFileExist testFile+ if existsAfter+ then removeFile testFile >> pure True+ else pure False+ validate "Suceed to delete temporary file" $ failure === False where testFile :: String testFile = "tmp"@@ -73,13 +75,10 @@ testData :: ByteString testData = "blah" - runTest :: Benchmark -> IO (Either CheckResult ())- runTest = withArgs (["-n","1"]) . try . C.defaultMainWith config . pure+ runTest :: Benchmark -> Check (Either CheckResult ())+ runTest = pick "run-test" . try . C.defaultMainWith config . pure where- config = C.defaultConfig { verbosity = Quiet , timeLimit = Just 1 }-- failTest :: String -> IO ()- failTest s = assertFailure $ s ++ " in test: " ++ name ++ "!"+ config = C.defaultConfig { verbosity = Quiet , timeLimit = Just 1, iters = Just 1 } resetHandle :: Handle -> IO () resetHandle hnd = hSeek hnd AbsoluteSeek 0@@ -96,14 +95,14 @@ hClose hnd removeFile testFile -testSuccess :: String -> BenchmarkWithFile -> TestTree+testSuccess :: String -> BenchmarkWithFile -> Test testSuccess = testCleanup False -testFailure :: String -> BenchmarkWithFile -> TestTree+testFailure :: String -> BenchmarkWithFile -> Test testFailure = testCleanup True main :: IO ()-main = defaultMain $ testGroup "cleanup"+main = defaultMain $ Group "cleanup" [ testSuccess "perRun Success" perRun , testFailure "perRun Failure" perRun , testSuccess "perBatch Success" perBatch
tests/Sanity.hs view
@@ -1,19 +1,17 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} -import Gauge.Benchmark (bench, bgroup, env, whnf)-import System.Environment (getEnv, withArgs)-import System.Timeout (timeout)-import Test.Tasty (defaultMain)-import Test.Tasty.HUnit (testCase)-import Test.HUnit (Assertion, assertFailure)+import System.Timeout (timeout)+import Data.Monoid+import Data.Word+import GHC.Exts (IsList(..))+ import qualified Gauge as C-import qualified Control.Exception as E-import qualified Data.ByteString as B+import Gauge.Main.Options+import Gauge.Benchmark (bench, bgroup, env, whnf) -#if !MIN_VERSION_bytestring(0,10,0)-import Control.DeepSeq (NFData (..))-#endif+import Foundation.Check+import Foundation.Check.Main fib :: Int -> Int fib = sum . go@@ -21,52 +19,41 @@ go 1 = [1] go n = go (n-1) ++ go (n-2) --- Additional arguments to include along with the ARGS environment variable.-extraArgs :: [String]-extraArgs = [ "--raw=sanity.dat", "--json=sanity.json", "--csv=sanity.csv"- , "--output=sanity.html", "--junit=sanity.junit"-#ifdef VERBOSE- , "-v 2"-#endif-#ifdef QUICK- , "--quick"-#endif- ]+withSpecialMain :: Bool -> Bool -> [C.Benchmark] -> IO ()+withSpecialMain useVerbose useQuick = C.defaultMainWith cfg+ where+ cfg = defaultConfig+ { rawDataFile = Just "sanity.dat"+ , jsonFile = Just "sanity.json"+ , csvFile = Just "sanity.csv"+ , reportFile = Just "sanity.html"+ , junitFile = Just "sanity.junit"+ , verbosity = if useVerbose then Verbose else verbosity defaultConfig+ , quickMode = useQuick+ } -sanity :: Assertion-sanity = do- args <- getArgEnv- withArgs (extraArgs ++ args) $ do+sanity :: Bool -> Bool -> Check ()+sanity useVerbose useQuick = do let tooLong = 30- wat <- timeout (tooLong * 1000000) $- C.defaultMain [- bgroup "fib" [- bench "fib 10" $ whnf fib 10- , bench "fib 22" $ whnf fib 22- ]- , env (return (replicate 1024 0)) $ \xs ->- bgroup "length . filter" [- bench "string" $ whnf (length . filter (==0)) xs- , env (return (B.pack xs)) $ \bs ->- bench "bytestring" $ whnf (B.length . B.filter (==0)) bs- ]- ]- case wat of- Just () -> return ()- Nothing -> assertFailure $ "killed for running longer than " ++- show tooLong ++ " seconds!"--main :: IO ()-main = defaultMain $ testCase "sanity" sanity+ wat <- pick "run-program" $ timeout (tooLong * 1000000) $ withSpecialMain useVerbose useQuick+ [ bgroup "fib"+ [ bench "fib 10" $ whnf fib 10+ , bench "fib 22" $ whnf fib 22+ ]+ , env (return (replicate 1024 0 :: [Word8])) $ \xs ->+ bgroup "length . filter"+ [ bench "string" $ whnf (length . filter (==0)) xs+ -- , env (return (B.pack xs)) $ \bs -> bench "uarray" $ whnf (B.length . B.filter (==0)) bs+ ]+ ] --- This is a workaround to in pass arguments that sneak past--- test-framework to get to criterion.-getArgEnv :: IO [String]-getArgEnv =- fmap words (getEnv "ARGS") `E.catch`- \(_ :: E.SomeException) -> return []+ validate ("not killed for running longer than " <> fromList (show tooLong) <> " seconds") $+ wat === Just () -#if !MIN_VERSION_bytestring(0,10,0)-instance NFData B.ByteString where- rnf bs = bs `seq` ()-#endif+main :: IO ()+main = defaultMain $ Group "gauge-sanity"+ [ CheckPlan "normal" $ sanity False False+ , CheckPlan "verbose" $ sanity True False+ , CheckPlan "quick" $ sanity False True+ , CheckPlan "verbose-quick" $ sanity True True+ ]