diff --git a/Gauge/Main.hs b/Gauge/Main.hs --- a/Gauge/Main.hs +++ b/Gauge/Main.hs @@ -57,15 +57,13 @@ import Foundation.Monad import Gauge.IO.Printf (printError) import Gauge.Internal (runAndAnalyse, runFixedIters) -import Gauge.Main.Options (MatchType(..), Mode(..), defaultConfig, describe, - versionInfo) +import Gauge.Main.Options (defaultConfig, versionInfo, parseWith, describe) import Gauge.Measurement (initializeTime) import Gauge.Monad (withConfig) import Gauge.Types import Data.Char (toLower) import Data.List (isInfixOf, isPrefixOf, sort) -import Options.Applicative (execParser) -import System.Environment (getProgName) +import System.Environment (getProgName, getArgs) import System.Exit (ExitCode(..), exitWith) -- import System.FilePath.Glob import System.IO.CodePage (withCP65001) @@ -135,29 +133,33 @@ -> [Benchmark] -> IO () defaultMainWith defCfg bs = withCP65001 $ do - wat <- execParser (describe defCfg) - runMode wat bs + args <- getArgs + let (cfg, extra) = parseWith defCfg args + runMode (mode cfg) cfg extra bs -- | Run a set of 'Benchmark's with the given 'Mode'. -- -- This can be useful if you have a 'Mode' from some other source (e.g. from a -- one in your benchmark driver's command-line parser). -runMode :: Mode -> [Benchmark] -> IO () -runMode wat bs = +runMode :: Mode -> Config -> [String] -> [Benchmark] -> IO () +runMode wat cfg benches bs = case wat of - List -> mapM_ putStrLn . sort . concatMap benchNames $ bs + List -> mapM_ putStrLn . sort . concatMap benchNames $ bs Version -> putStrLn versionInfo - RunIters cfg iters matchType benches -> do - shouldRun <- selectBenches matchType benches bsgroup - withConfig cfg $ - runFixedIters iters shouldRun bsgroup - Run cfg matchType benches -> do - shouldRun <- selectBenches matchType benches bsgroup - withConfig cfg $ do - --writeCsv ("Name","Mean","MeanLB","MeanUB","Stddev","StddevLB", - -- "StddevUB") - liftIO initializeTime - runAndAnalyse shouldRun bsgroup + Help -> putStrLn describe + DefaultMode -> + case iters cfg of + Just nbIters -> do + shouldRun <- selectBenches (match cfg) benches bsgroup + withConfig cfg $ + runFixedIters nbIters shouldRun bsgroup + Nothing -> do + shouldRun <- selectBenches (match cfg) benches bsgroup + withConfig cfg $ do + --writeCsv ("Name","Mean","MeanLB","MeanUB","Stddev","StddevLB", + -- "StddevUB") + liftIO initializeTime + runAndAnalyse shouldRun bsgroup where bsgroup = BenchGroup "" bs -- | Display an error message from a command line parsing failure, and diff --git a/Gauge/Main/Options.hs b/Gauge/Main/Options.hs --- a/Gauge/Main/Options.hs +++ b/Gauge/Main/Options.hs @@ -12,10 +12,8 @@ -- Benchmarking command-line configuration. module Gauge.Main.Options - ( - Mode(..) - , MatchType(..) - , defaultConfig + ( defaultConfig + , parseWith , describe , versionInfo ) where @@ -23,54 +21,21 @@ -- Temporary: to support pre-AMP GHC 7.8.4: import Data.Monoid -import Control.Monad (when) import Gauge.Analysis (validateAccessors) -import Gauge.Types (Config(..), Verbosity(..), measureAccessors, - measureKeys) +import Gauge.Types (Config(..), Verbosity(..), Mode(..), MatchType(..)) +--import Gauge.Types (Config(..), Verbosity(..), measureAccessors, measureKeys, Mode(..), MatchType(..)) import Data.Char (isSpace, toLower) -import Data.Data (Data, Typeable) -import Data.Int (Int64) -import Data.List (isPrefixOf) +import Data.List (foldl') import Data.Version (showVersion) -import GHC.Generics (Generic) -import Options.Applicative -import Options.Applicative.Help (Chunk(..), tabulate) -import Options.Applicative.Help.Pretty ((.$.)) -import Options.Applicative.Types +import System.Console.GetOpt import Paths_gauge (version) import Statistics.Types (mkCL,cl95) -import Text.PrettyPrint.ANSI.Leijen (Doc, text) -import qualified Data.Map as M import Prelude --- | How to match a benchmark name. -data MatchType = Prefix - -- ^ Match by prefix. For example, a prefix of - -- @\"foo\"@ will match @\"foobar\"@. - | Pattern - -- ^ Match by searching given substring in benchmark - -- paths. - | IPattern - -- ^ Same as 'Pattern', but case insensitive. - deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data, - Generic) - --- | Execution mode for a benchmark program. -data Mode = List - -- ^ List all benchmarks. - | Version - -- ^ Print the version. - | RunIters Config Int64 MatchType [String] - -- ^ Run the given benchmarks, without collecting or - -- analysing performance numbers. - | Run Config MatchType [String] - -- ^ Run and analyse the given benchmarks. - deriving (Eq, Read, Show, Typeable, Data, Generic) - -- | Default benchmarking configuration. defaultConfig :: Config -defaultConfig = Config { - confInterval = cl95 +defaultConfig = Config + { confInterval = cl95 , forceGC = True , timeLimit = 5 , resamples = 1000 @@ -82,119 +47,122 @@ , junitFile = Nothing , verbosity = Normal , template = "default" + , iters = Nothing + , match = Prefix + , mode = DefaultMode } --- | Parse a command line. parseWith :: Config - -- ^ Default configuration to use if options are not - -- explicitly specified. - -> Parser Mode -parseWith cfg = - (matchNames (Run <$> config cfg)) <|> - runIters <|> - (List <$ switch (long "list" <> short 'l' <> help "List benchmarks")) <|> - (Version <$ switch (long "version" <> help "Show version info")) + -- ^ Default configuration to use + -> [String] + -- ^ Program Argument + -> (Config, [String]) +parseWith start argv = + case getOpt Permute opts argv of + (o,n,[] ) -> (foldl' (flip id) start o, n) + (_,_,errs) -> optionError (concat errs ++ usageInfo header opts) + +opts :: [OptDescr (Config -> Config)] +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" + , Option "" ["resamples"] (ReqArg setResamples "COUNT") "Number of boostrap resamples to perform" + , Option "" ["regress"] (ReqArg setRegressions "RESP:PRED..") "Regressions to perform" + , Option "" ["raw"] (fileArg setRaw) "File to write raw data to" + , Option "o" ["output"] (fileArg setOutput) "File to write report to" + , Option "" ["csv"] (fileArg setCSV) "File to write CSV summary to" + , Option "" ["json"] (fileArg setJSON) "File to write JSON summary to" + , Option "" ["junit"] (fileArg setJUnit) "File to write JUnit summary to" + , 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 "l" ["list"] (NoArg $ setMode List) "List benchmarks" + , Option "" ["version"] (NoArg $ setMode Version) "Show version info" + , Option "h" ["help"] (NoArg $ setMode Help) "Show help" + ] where - runIters = matchNames $ - RunIters <$> config cfg <*> option auto - (long "iters" <> short 'n' <> metavar "ITERS" <> - help "Run benchmarks, don't analyse") - matchNames wat = wat - <*> option match - (long "match" <> short 'm' <> metavar "MATCH" <> value Prefix <> - help "How to match benchmark names (\"prefix\", \"glob\", \"pattern\", or \"ipattern\")") - <*> many (argument str (metavar "NAME...")) + fileArg f = ReqArg f "FILE" + setCI s v = v { confInterval = mkCL (range 0.001 0.999 s) } + setNoGC v = v { forceGC = False } + setTimeLimit s v = v { timeLimit = range 0.1 86400 s } + setResamples s v = v { resamples = range 1 1000000 s } + setRegressions s v = v { regressions = regressParams s : regressions v } + setRaw f v = v { rawDataFile = Just f } + setOutput f v = v { reportFile = Just f } + setCSV f v = v { csvFile = Just f } + setJSON f v = v { jsonFile = Just f } + setJUnit f v = v { junitFile = Just f } + setVerbosity s v = v { verbosity = toEnum (range 0 2 s) } + setTemplate f v = v { template = f } + setIters s v = v { iters = Just $ read s } + setMatch s v = + let m = case map toLower s of + "pfx" -> Prefix + "prefix" -> Prefix + "pattern" -> Pattern + "ipattern" -> IPattern + _ -> optionError ("unknown match type: " <> s) + in v { match = m } + setMode m v = v { mode = m } --- | Parse a configuration. -config :: Config -> Parser Config -config Config{..} = Config - <$> option (mkCL <$> range 0.001 0.999) - (long "ci" <> short 'I' <> metavar "CI" <> value confInterval <> - help "Confidence interval") - <*> (not <$> switch (long "no-gc" <> short 'G' <> - help "Do not collect garbage between iterations")) - <*> option (range 0.1 86400) - (long "time-limit" <> short 'L' <> metavar "SECS" <> value timeLimit <> - help "Time limit to run a benchmark") - <*> option (range 1 1000000) - (long "resamples" <> metavar "COUNT" <> value resamples <> - help "Number of bootstrap resamples to perform") - <*> many (option regressParams - (long "regress" <> metavar "RESP:PRED.." <> - help "Regressions to perform")) - <*> outputOption rawDataFile (long "raw" <> - help "File to write raw data to") - <*> outputOption reportFile (long "output" <> short 'o' <> - help "File to write report to") - <*> outputOption csvFile (long "csv" <> - help "File to write CSV summary to") - <*> outputOption jsonFile (long "json" <> - help "File to write JSON summary to") - <*> outputOption junitFile (long "junit" <> - help "File to write JUnit summary to") - <*> (toEnum <$> option (range 0 2) - (long "verbosity" <> short 'v' <> metavar "LEVEL" <> - value (fromEnum verbosity) <> - help "Verbosity level")) - <*> strOption (long "template" <> short 't' <> metavar "FILE" <> - value template <> - help "Template to use for report") +-- FIXME +optionError :: String -> a +optionError s = error s -outputOption :: Maybe String -> Mod OptionFields String -> Parser (Maybe String) -outputOption file m = - optional (strOption (m <> metavar "FILE" <> maybe mempty value file)) +range :: (Show a, Read a, Ord a) => a -> a -> String -> a +range lo hi s = do + case reads s of + [(i, "")] + | i >= lo && i <= hi -> i + | otherwise -> optionError $ show i ++ " is outside range " ++ show (lo,hi) + _ -> optionError $ show s ++ " is not a number" -range :: (Show a, Read a, Ord a) => a -> a -> ReadM a -range lo hi = do - s <- readerAsk - case reads s of - [(i, "")] - | i >= lo && i <= hi -> return i - | otherwise -> readerError $ show i ++ " is outside range " ++ - show (lo,hi) - _ -> readerError $ show s ++ " is not a number" +{- +Regression metrics (for use with --regress): + time wall-clock time + cpuTime CPU time + cycles CPU cycles + iters loop iterations + allocated (+RTS -T) bytes allocated + numGcs (+RTS -T) number of garbage collections + bytesCopied (+RTS -T) number of bytes copied during GC + mutatorWallSeconds (+RTS -T) wall-clock time for mutator threads + mutatorCpuSeconds (+RTS -T) CPU time spent running mutator threads + gcWallSeconds (+RTS -T) wall-clock time spent doing GC + gcCpuSeconds (+RTS -T) CPU time spent doing GC +Benchmark self: FINISH -match :: ReadM MatchType -match = do - m <- readerAsk - case map toLower m of - mm | mm `isPrefixOf` "pfx" -> return Prefix - | mm `isPrefixOf` "prefix" -> return Prefix - | mm `isPrefixOf` "pattern" -> return Pattern - | mm `isPrefixOf` "ipattern" -> return IPattern - | otherwise -> readerError $ - show m ++ " is not a known match type" - ++ "Try \"prefix\", \"pattern\", \"ipattern\"." +-- We sort not by name, but by likely frequency of use. +regressionHelp :: Chunk Doc +regressionHelp = + fmap (text "Regression metrics (for use with --regress):" .$.) $ + tabulate [(text n,text d) | (n,(_,d)) <- map f measureKeys] + where f k = (k, measureAccessors M.! k) + -} -regressParams :: ReadM ([String], String) -regressParams = do - m <- readerAsk - let repl ',' = ' ' - repl c = c - tidy = reverse . dropWhile isSpace . reverse . dropWhile isSpace - (r,ps) = break (==':') m - when (null r) $ - readerError "no responder specified" - when (null ps) $ - readerError "no predictors specified" - let ret = (words . map repl . drop 1 $ ps, tidy r) - either readerError (const (return ret)) $ uncurry validateAccessors ret +describe :: String +describe = usageInfo header opts --- | Flesh out a command line parser. -describe :: Config -> ParserInfo Mode -describe cfg = info (helper <*> parseWith cfg) $ - header ("Microbenchmark suite - " <> versionInfo) <> - fullDesc <> - footerDoc (unChunk regressionHelp) +header :: String +header = "Microbenchmark suite - " <> versionInfo -- | A string describing the version of this benchmark (really, the -- version of gauge that was used to build it). versionInfo :: String versionInfo = "built with gauge " <> showVersion version --- We sort not by name, but by likely frequency of use. -regressionHelp :: Chunk Doc -regressionHelp = - fmap (text "Regression metrics (for use with --regress):" .$.) $ - tabulate [(text n,text d) | (n,(_,d)) <- map f measureKeys] - where f k = (k, measureAccessors M.! k) +regressParams :: String -> ([String], String) +regressParams m + | null r = optionError "no responder specified" + | null ps = optionError "no predictors specified" + | otherwise = + let ret = (words . map repl . drop 1 $ ps, tidy r) + in either optionError (const ret) $ uncurry validateAccessors ret + where + repl ',' = ' ' + repl c = c + tidy = reverse . dropWhile isSpace . reverse . dropWhile isSpace + (r,ps) = break (==':') m + diff --git a/Gauge/Measurement.hs b/Gauge/Measurement.hs --- a/Gauge/Measurement.hs +++ b/Gauge/Measurement.hs @@ -118,7 +118,7 @@ {-# DEPRECATED getGCStats ["GCStats has been deprecated in GHC 8.2. As a consequence,", "getGCStats has also been deprecated in favor of getGCStatistics.", - "getGCStats will be removed in the next major criterion release."] #-} + "getGCStats will be removed in the next major gauge release."] #-} getGCStats :: IO (Maybe GCStats) getGCStats = (Just `fmap` Stats.getGCStats) `Exc.catch` \(_::Exc.SomeException) -> @@ -334,7 +334,7 @@ {-# DEPRECATED applyGCStats ["GCStats has been deprecated in GHC 8.2. As a consequence,", "applyGCStats has also been deprecated in favor of applyGCStatistics.", - "applyGCStats will be removed in the next major criterion release."] #-} + "applyGCStats will be removed in the next major gauge release."] #-} applyGCStats :: Maybe GCStats -- ^ Statistics gathered at the __end__ of a run. -> Maybe GCStats @@ -399,17 +399,17 @@ | otherwise = printf "%.3f %s" t u -- | Set up time measurement. -foreign import ccall unsafe "criterion_inittime" initializeTime :: IO () +foreign import ccall unsafe "gauge_inittime" initializeTime :: IO () -- | Read the CPU cycle counter. -foreign import ccall unsafe "criterion_rdtsc" getCycles :: IO Word64 +foreign import ccall unsafe "gauge_rdtsc" getCycles :: IO Word64 -- | Return the current wallclock time, in seconds since some -- arbitrary time. -- -- You /must/ call 'initializeTime' once before calling this function! -foreign import ccall unsafe "criterion_gettime" getTime :: IO Double +foreign import ccall unsafe "gauge_gettime" getTime :: IO Double -- | Return the amount of elapsed CPU time, combining user and kernel -- (system) time into a single measure. -foreign import ccall unsafe "criterion_getcputime" getCPUTime :: IO Double +foreign import ccall unsafe "gauge_getcputime" getCPUTime :: IO Double diff --git a/Gauge/Monad.hs b/Gauge/Monad.hs --- a/Gauge/Monad.hs +++ b/Gauge/Monad.hs @@ -9,7 +9,7 @@ -- Stability : experimental -- Portability : GHC -- --- The environment in which most criterion code executes. +-- The environment in which most gauge code executes. module Gauge.Monad ( Gauge diff --git a/Gauge/Monad/Internal.hs b/Gauge/Monad/Internal.hs --- a/Gauge/Monad/Internal.hs +++ b/Gauge/Monad/Internal.hs @@ -11,7 +11,7 @@ -- Stability : experimental -- Portability : GHC -- --- The environment in which most criterion code executes. +-- The environment in which most gauge code executes. module Gauge.Monad.Internal ( Gauge(..) @@ -34,7 +34,7 @@ , overhead :: !(IORef (Maybe Double)) } --- | The monad in which most criterion code executes. +-- | The monad in which most gauge code executes. newtype Gauge a = Gauge { runGauge :: ReaderT Crit IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch) -- , MonadBracket) diff --git a/Gauge/Types.hs b/Gauge/Types.hs --- a/Gauge/Types.hs +++ b/Gauge/Types.hs @@ -29,6 +29,8 @@ ( -- * Configuration Config(..) + , Mode(..) + , MatchType(..) , Verbosity(..) -- * Benchmark descriptions , Benchmarkable(..) @@ -93,6 +95,31 @@ deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data, Generic) +-- | How to match a benchmark name. +data MatchType = Prefix + -- ^ Match by prefix. For example, a prefix of + -- @\"foo\"@ will match @\"foobar\"@. + | Pattern + -- ^ Match by searching given substring in benchmark + -- paths. + | IPattern + -- ^ Same as 'Pattern', but case insensitive. + deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data, + Generic) + +-- | Execution mode for a benchmark program. +data Mode = List + -- ^ List all benchmarks. + | Version + -- ^ Print the version. + | Help + -- ^ Print help + | DefaultMode + -- ^ Default Benchmark mode + deriving (Eq, Read, Show, Typeable, Data, Generic) + + + -- | Top-level benchmarking configuration. data Config = Config { confInterval :: St.CL Double @@ -126,6 +153,12 @@ -- benchmarks. , template :: FilePath -- ^ Template file to use if writing a report. + , iters :: Maybe Int64 + -- ^ Number of iterations + , match :: MatchType + -- ^ Type of matching to use, if any + , mode :: Mode + -- ^ Mode of operation } deriving (Eq, Read, Show, Typeable, Data, Generic) @@ -347,9 +380,7 @@ -- A common example of environment data is input that is read from a -- file. Another is a large data structure constructed in-place. -- --- __Motivation.__ In earlier versions of criterion, all benchmark --- inputs were always created when a program started running. By --- deferring the creation of an environment when its associated +-- By deferring the creation of an environment when its associated -- benchmarks need the its, we avoid two problems that this strategy -- caused: -- diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,1 +1,78 @@ # Gauge: a clone of criterion + +This is a clone of criterion with a code / dependencies on a diet. It works the same way as criterion +for outputing to terminal benchmark data. + +## features compared to criterion + +missing: + +* CSV export +* JSON export +* HTML/javascript pages + +## Future Feature Plan + +* Remove further dependencies +* storing benchmarks data in CSV and JSON +* Add a standalong program taking benchmark data files and rendering to html/javascript/graphs +* Make the library more useful as a standalone library to gather benchmark numbers related to functions in a programatic way + +## Direct dependencies removed compared to criterion + +Number of total dependencies (direct & indirect): + +* gauge: 20 dependencies +* criterion: 63 dependencies + +Dependencies removed: + +* Glob 0.8.0 +* abstract-deque 0.3 +* abstract-par 0.3.3 +* aeson 1.1.2.0 +* ansi-terminal 0.6.3.1 +* ansi-wl-pprint 0.6.7.3 +* array 0.5.1.1 +* attoparsec 0.13.1.0 +* base-compat 0.9.3 +* base-orphans 0.6 +* binary 0.8.3.0 +* blaze-builder 0.4.0.2 +* bytestring 0.10.8.1 +* cassava 0.4.5.1 +* cereal 0.5.4.0 +* criterion 1.2.2.0 +* directory 1.3.0.0 +* dlist 0.8.0.3 +* erf 2.0.0.0 +* exceptions 0.8.3 +* filepath 1.4.1.1 +* hashable 1.2.6.1 +* integer-logarithms 1.0.2 +* js-flot 0.8.3 +* js-jquery 3.2.1 +* microstache 1.0.1.1 +* monad-par 0.3.4.8 +* monad-par-extras 0.3.3 +* mtl 2.2.1 +* optparse-applicative 0.13.2.0 +* parallel 3.2.1.1 +* parsec 3.1.11 +* process 1.4.3.0 +* random 1.1 +* scientific 0.3.5.2 +* statistics 0.14.0.2 +* stm 2.4.4.1 +* tagged 0.8.5 +* text 1.2.2.2 +* time-locale-compat 0.1.1.3 +* transformers-compat 0.5.1.4 +* unix 2.7.2.1 +* unordered-containers 0.2.8.0 +* uuid-types 1.0.3 +* vector-algorithms 0.7.0.1 +* vector-binary-instances 0.2.3.5 + +![Criterion](/.README.imgs/criterion.png) +![Gauge](/.README.imgs/gauge.png) diff --git a/benchs/Main.hs b/benchs/Main.hs new file mode 100644 --- /dev/null +++ b/benchs/Main.hs @@ -0,0 +1,7 @@ +module Main where + +import Gauge.Main + +main = defaultMain + [ bench "identity" $ whnf (map (+ 1)) [1,2,3 :: Int] + ] diff --git a/cbits/cycles.c b/cbits/cycles.c --- a/cbits/cycles.c +++ b/cbits/cycles.c @@ -2,7 +2,7 @@ #if x86_64_HOST_ARCH || i386_HOST_ARCH -StgWord64 criterion_rdtsc(void) +StgWord64 gauge_rdtsc(void) { StgWord32 hi, lo; __asm__ __volatile__ ("rdtsc" : "=a"(lo), "=d"(hi)); @@ -42,7 +42,7 @@ } StgWord64 -criterion_rdtsc (void) +gauge_rdtsc (void) { StgWord64 result = 0; if (read (fddev, &result, sizeof(result)) < sizeof(result)) diff --git a/cbits/time-osx.c b/cbits/time-osx.c --- a/cbits/time-osx.c +++ b/cbits/time-osx.c @@ -4,7 +4,7 @@ static mach_timebase_info_data_t timebase_info; static double timebase_recip; -void criterion_inittime(void) +void gauge_inittime(void) { if (timebase_recip == 0) { mach_timebase_info(&timebase_info); @@ -12,7 +12,7 @@ } } -double criterion_gettime(void) +double gauge_gettime(void) { return mach_absolute_time() * timebase_recip; } @@ -22,7 +22,7 @@ return time.seconds + time.microseconds / 1e6; } -double criterion_getcputime(void) +double gauge_getcputime(void) { struct task_thread_times_info thread_info_data; mach_msg_type_number_t thread_info_count = TASK_THREAD_TIMES_INFO_COUNT; diff --git a/cbits/time-posix.c b/cbits/time-posix.c --- a/cbits/time-posix.c +++ b/cbits/time-posix.c @@ -1,10 +1,10 @@ #include -void criterion_inittime(void) +void gauge_inittime(void) { } -double criterion_gettime(void) +double gauge_gettime(void) { struct timespec ts; @@ -14,7 +14,7 @@ } -double criterion_getcputime(void) +double gauge_getcputime(void) { struct timespec ts; diff --git a/cbits/time-windows.c b/cbits/time-windows.c --- a/cbits/time-windows.c +++ b/cbits/time-windows.c @@ -17,11 +17,11 @@ #if 0 -void criterion_inittime(void) +void gauge_inittime(void) { } -double criterion_gettime(void) +double gauge_gettime(void) { FILETIME ft; ULARGE_INTEGER li; @@ -38,7 +38,7 @@ static double freq_recip; static LARGE_INTEGER firstClock; -void criterion_inittime(void) +void gauge_inittime(void) { LARGE_INTEGER freq; @@ -49,7 +49,7 @@ } } -double criterion_gettime(void) +double gauge_gettime(void) { LARGE_INTEGER li; @@ -68,7 +68,7 @@ return li.QuadPart; } -double criterion_getcputime(void) +double gauge_getcputime(void) { FILETIME creation, exit, kernel, user; ULONGLONG time; diff --git a/gauge.cabal b/gauge.cabal --- a/gauge.cabal +++ b/gauge.cabal @@ -1,5 +1,5 @@ name: gauge -version: 0.1.0 +version: 0.1.1 synopsis: small framework for performance measurement and analysis license: BSD3 license-file: LICENSE @@ -77,7 +77,6 @@ Paths_gauge build-depends: - ansi-wl-pprint >= 0.6.7.2, base >= 4.5 && < 5, basement, foundation, @@ -85,7 +84,6 @@ containers, deepseq >= 1.1.0.0, mwc-random >= 0.8.0.3, - optparse-applicative >= 0.13, vector >= 0.7.1, -- formely statistics dependency that we need @@ -110,25 +108,6 @@ tasty, tasty-hunit -test-suite tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: Tests.hs - default-language: Haskell2010 - other-modules: Properties - - ghc-options: - -Wall -threaded -O0 -rtsopts - - build-depends: - QuickCheck >= 2.4, - base, - gauge, - statistics, - tasty, - tasty-quickcheck, - vector - test-suite cleanup type: exitcode-stdio-1.0 hs-source-dirs: tests @@ -148,6 +127,15 @@ foundation, tasty, tasty-hunit + +benchmark self + type: exitcode-stdio-1.0 + hs-source-dirs: benchs + default-language: Haskell2010 + main-is: Main.hs + build-depends: + base, + gauge source-repository head type: git diff --git a/tests/Properties.hs b/tests/Properties.hs deleted file mode 100644 --- a/tests/Properties.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Properties (tests) where - -import Control.Applicative as A ((<$>)) -import Gauge.Analysis -import Statistics.Types (Sample) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck -import qualified Data.Vector.Generic as G -import qualified Data.Vector.Unboxed as U - -#if __GLASGOW_HASKELL__ >= 704 -import Data.Monoid ((<>)) -#else -import Data.Monoid - -(<>) :: Monoid m => m -> m -> m -(<>) = mappend -infixr 6 <> -#endif - -instance (Arbitrary a, U.Unbox a) => Arbitrary (U.Vector a) where - arbitrary = U.fromList A.<$> arbitrary - shrink = map U.fromList . shrink . U.toList - -outlier_bucketing :: Double -> Sample -> Bool -outlier_bucketing y ys = - countOutliers (classifyOutliers xs) <= fromIntegral (G.length xs) - where xs = U.cons y ys - -outlier_bucketing_weighted :: Double -> Sample -> Bool -outlier_bucketing_weighted x xs = - outlier_bucketing x (xs <> G.replicate (G.length xs * 10) 0) - -tests :: TestTree -tests = testGroup "Properties" [ - testProperty "outlier_bucketing" outlier_bucketing - , testProperty "outlier_bucketing_weighted" outlier_bucketing_weighted - ] diff --git a/tests/Tests.hs b/tests/Tests.hs deleted file mode 100644 --- a/tests/Tests.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Main (main) where - -import Properties -import Test.Tasty (defaultMain, testGroup) - -main :: IO () -main = defaultMain $ testGroup "Tests" - [ Properties.tests - ]