From b61c4f85e670a1e66700fb5e335da0ad02d5b98c Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 26 Nov 2008 19:00:55 +0000 Subject: [PATCH] "make bench" runs some benchmark tests and saves results --- Makefile | 4 ++ NOTES | 1 - bench.tests | 6 +++ tools/bench.hs | 125 +++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 135 insertions(+), 1 deletion(-) create mode 100644 bench.tests create mode 100644 tools/bench.hs diff --git a/Makefile b/Makefile index 541fe7f15..5d5a086b5 100644 --- a/Makefile +++ b/Makefile @@ -29,6 +29,10 @@ test: @./hledger.hs test @./regtest.py +# run performance benchmarks and save results in profs +bench: + tools/bench.hs bench.tests 2 hledger ledger "ledger --no-cache" | tee profs/`date +%Y%m%d%H%M%S`.bench + VERSION=`grep 'versionno =' Options.hs | perl -pe 's/.*"(.*?)"/\1/'` release: cabal sdist && darcs tag $(VERSION) && cabal upload dist/hledger-$(VERSION).tar.gz diff --git a/NOTES b/NOTES index 55296cccd..9b45eae18 100644 --- a/NOTES +++ b/NOTES @@ -18,7 +18,6 @@ clever tricks like the plague." --Edsger Dijkstra *** ~/.hledgerrc, for setting defaults *** more ledger features from README (?) *** speed -**** easy benchmarking **** speed regression tests **** easy profiling **** cache file ? diff --git a/bench.tests b/bench.tests new file mode 100644 index 000000000..dd2412140 --- /dev/null +++ b/bench.tests @@ -0,0 +1,6 @@ +# see tools/bench.hs + +-f sample.ledger register +-f sample.ledger -s balance +-f ~/.ledger register +-f ~/.ledger -s balance diff --git a/tools/bench.hs b/tools/bench.hs new file mode 100644 index 000000000..f656b56c9 --- /dev/null +++ b/tools/bench.hs @@ -0,0 +1,125 @@ +#!/usr/bin/env runhaskell +{- +bench.hs (see usage string below). + +For simple benchmarking. Similar to my darcs-benchmark/bench.hs script. +Example: + +$ cat - >bench.tests +-f sample.ledger -s balance +-f ~/.ledger -s balance +$ bench.hs bench.tests 2 hledger "ledger --no-cache" ledger +Running 2 tests 2 times in . with 3 executables at 2008-11-26 18:52:15.776357 UTC: +1: hledger -f sample.ledger -s balance [0.02s] +2: hledger -f sample.ledger -s balance [0.01s] +1: ledger --no-cache -f sample.ledger -s balance [0.02s] +2: ledger --no-cache -f sample.ledger -s balance [0.02s] +1: ledger -f sample.ledger -s balance [0.02s] +2: ledger -f sample.ledger -s balance [0.02s] +1: hledger -f ~/.ledger -s balance [3.56s] +2: hledger -f ~/.ledger -s balance [3.56s] +1: ledger --no-cache -f ~/.ledger -s balance [0.10s] +2: ledger --no-cache -f ~/.ledger -s balance [0.10s] +1: ledger -f ~/.ledger -s balance [0.10s] +2: ledger -f ~/.ledger -s balance [0.10s] + +Summary (best iteration): + + || hledger | ledger --no-cache | ledger +============================++=========+===================+======= +-f sample.ledger -s balance || 0.01 | 0.02 | 0.02 + -f ~/.ledger -s balance || 3.56 | 0.10 | 0.10 + +-} + +import Data.Char +import Data.List +import Data.Maybe +import Numeric +import System.Environment +import System.Directory +import System.FilePath +import System.Cmd +import System.IO +import Text.Tabular +import qualified Text.Tabular.AsciiArt as TA +import qualified Text.Tabular.Html as TH +import Text.Html ((+++), renderHtml) +import System.Exit +import Text.Printf +import Data.Time.Clock +import Data.Time.Format +import System.Locale +import Control.Monad +import Debug.Trace + + + +usage = "bench.hs [ ...]\n" ++ + "\n" ++ + "Run some functional tests, defined as lines of arguments in\n" ++ + "testsfile, num times with each of the specified executables,\n" ++ + "printing the execution times and a summary.\n" ++ + "Tips:\n" ++ + "- comment out tests with #\n" + +precision = 2 + +main = do + (testsfile,iterations,dir,exes) <- getArgs >>= return . parseargs + tests <- readFile testsfile >>= return . testlines + now <- getCurrentTime + putStrLn $ printf "Running %d tests %d times in %s with %d executables at %s:\n" + (length tests) (iterations) dir (length exes) (show now) + let doexe t e = sequence $ map (doiteration t e dir) [1..iterations] + let dotest t = sequence $ map (doexe t) exes + hSetBuffering stdout NoBuffering + results <- mapM dotest tests + summarise tests exes results + where +-- parseargs (t:n:d:[]) = parseargs (t:n:d:["darcs"]) + parseargs (t:n:es) = (t,read n,".",es) + parseargs _ = error $ "\n" ++ usage + testlines s = filter istest $ map clean $ lines s + istest s = not (null s || ("#" `isPrefixOf` s)) + clean = unwords . words + +doiteration :: String -> String -> String -> Int -> IO Float +doiteration test exe dir iteration = do + let cmd = unwords [exe,test] + putStr $ show iteration ++ ": " ++ cmd + hFlush stdout + t <- time cmd + printf "\t[%ss]\n" (showtime t) + return t + +time :: String -> IO Float +time cmd = do + t1 <- getCurrentTime + ret <- system $ cmd ++ ">/dev/null 2>&1" + case ret of + ExitSuccess -> return () + ExitFailure f -> putStr $ printf " (error %d)" f + t2 <- getCurrentTime + return $ realToFrac $ diffUTCTime t2 t1 + +summarise tests exes results = do + -- putStrLn ""; print results + putStrLn "\nSummary (best iteration):\n" + let t = maketable tests exes results + putStrLn $ TA.render id t + -- putStrLn $ "See " ++ prefix ++ "summary.*" + let outname = "summary" + writeFile (outname <.> "txt") $ TA.render id t + writeFile (outname <.> "html") $ renderHtml $ TH.css TH.defaultCss +++ TH.render id t + +maketable :: [String] -> [String] -> [[[Float]]] -> Table String +maketable rownames colnames results = Table rowhdrs colhdrs rows + where + rowhdrs = Group NoLine $ map Header rownames + colhdrs = Group SingleLine $ map Header colnames + rows = map (map (showtime . minimum)) results + +showtime = printf $ "%."++(show precision)++"f" + +strace a = trace (show a) a