Hi,
this bundle primarily implements tracking of binaries based on their
--exact-version. This makes the "darcs-benchmark report" command *much* more
robust. If I ran darcs-benchmark against my default darcs (which is HEAD most
of the time) multiple times, with recompiling/reinstalling in between, the
output would now look like this:
[snip]
darcs 0: 2.4.98.1 (+ 103 patches),
2010-08-06 13:27:39, GHC 6.12.1
darcs 1: 2.4.98.1 (+ 109 patches),
2010-08-07 01:51:04, GHC 6.12.1
darcs-2.3: 2.3.0 (release),
2009-08-11 16:03:11, GHC 6.10.4
[snip]
====== ===== ======= ========== ======= ========== =======
2.3 sdev op darcs 0 sdev op darcs 1 sdev
====== ===== ======= ========== ======= ========== =======
wh 6.3ms (0.3ms) 6.9ms (0.8ms) 6.6ms (0.6ms)
wh mod 9.6ms (0.5ms) 11.2ms (1.2ms) 11.2ms (1.2ms)
wh -l - - 7.7ms (0.4ms) 7.7ms (0.3ms)
====== ===== ======= ========== ======= ========== =======
[...]
You can see that the two builds are now correctly separated. You can also
notice that the binaries automatically get a fairly detailed description in the
output.
Apart from sheer robustness, the importance of this feature lies with
automation: we run darcs-benchmark on buildbot after each checkin. With these
patches, darcs-benchmark can start collecting data that is properly separable:
each build will get its own numbers (right now, everything is mashed into a
single lump called "darcs-HEAD"). From that data, we could start plotting
performance per buildbot run automatically (this will need a new output format
for report, presumably).
Yours,
Petr.
PS: There's a couple of unrelated patches in here -- since one of those got
pulled in through dependencies, I figured I could as well include all of
them... The above is implemented by the last 2 patches.
5 patches for repository code.haskell.org:/srv/code/darcs/darcs-benchmark:
Wed Jul 28 11:21:13 CEST 2010 Petr Rockai <[email protected]>
* Remove extra "mod" bits from benchmark names.
Wed Jul 28 12:25:30 CEST 2010 Petr Rockai <[email protected]>
* Add a "git" repo variant, created using tailor.
Wed Jul 28 23:45:14 CEST 2010 Petr Rockai <[email protected]>
* Improve tailor conversion resilience a bit.
Sat Aug 7 01:29:55 CEST 2010 Petr Rockai <[email protected]>
* Keep track of exact versions of test binaries.
Sat Aug 7 01:54:43 CEST 2010 Petr Rockai <[email protected]>
* Disambiguate different binaries with same name in reports.
New patches:
[Remove extra "mod" bits from benchmark names.
Petr Rockai <[email protected]>**20100728092113
Ignore-this: 19c27c7c411834b57632fbf59481a31
] hunk ./Standard.hs 76
return ()
-- | n patches for each file
-record_mod :: BenchmarkCmd ()
-record_mod darcs _ = do
+record :: BenchmarkCmd ()
+record darcs _ = do
cd "repo"
files <- filterM test_f =<< ls "."
forM_ files $ \f -> liftIO (appendFile f "x")
hunk ./Standard.hs 85
darcs [ "obliterate", "--last=1", "--all" ]
return ()
-revert_mod :: BenchmarkCmd ()
-revert_mod darcs _ = do
+revert :: BenchmarkCmd ()
+revert darcs _ = do
cd "repo"
files <- filterM test_f =<< ls "."
forM_ files $ \f -> liftIO (appendFile f "foo")
hunk ./Standard.hs 108
[ Idempotent "wh" FastB wh
, Idempotent "wh mod" FastB wh_mod
, Idempotent "wh -l" FastB wh_l
- , Idempotent "record mod" FastB $ record_mod
- , Idempotent "revert mod" FastB revert_mod
- , Idempotent "(un)revert mod" FastB revert_unrevert
+ , Idempotent "record" FastB $ record
+ , Idempotent "revert" FastB revert
+ , Idempotent "(un)revert" FastB revert_unrevert
, Destructive "get (full)" SlowB $ get []
, Destructive "get (lazy)" FastB $ get ["--lazy"]
, Idempotent "pull 100" FastB $ pull 100
[Add a "git" repo variant, created using tailor.
Petr Rockai <[email protected]>**20100728102530
Ignore-this: 46369030ab8e4ba2409a43bd85d6d8bf
] hunk ./Benchmark.hs 22
import System.Console.CmdArgs (isLoud)
import System.Process( runInteractiveProcess, runInteractiveCommand,
waitForProcess )
+import System.Cmd( system )
import qualified System.IO.UTF8 as UTF8
copyTree :: FilePath -> FilePath -> IO ()
hunk ./Benchmark.hs 222
-- variants
-- ----------------------------------------------------------------------
+prepareTailor :: String -> String -> String -> IO ()
+prepareTailor from to target = do
+ exists <- doesDirectoryExist "_tailor"
+ when exists $ removeDirectoryRecursive "_tailor"
+ createDirectory "_tailor"
+ wd <- getCurrentDirectory
+ writeFile "_tailor/config" (config wd)
+ where config wd = unlines [ "[DEFAULT]", "verbose = True", "", "[benchmark]"
+ , "target = " ++ target ++ ":target"
+ , "start-revision = INITIAL"
+ , "root-directory = " ++ (wd </> "_tailor")
+ , "state-file = tailor.state"
+ , "source = darcs:source"
+ , "subdir = ."
+ , ""
+ , "[darcs:source]"
+ , "repository = " ++ (wd </> from)
+ , "subdir = checkout"
+ , ""
+ , "[" ++ target ++ ":target]"
+ , "subdir = ../" ++ to ]
+
mkVariant :: String -> String -> Variant -> Command ()
hunk ./Benchmark.hs 245
-mkVariant origrepo darcs_path v =
- case vId v of
- OptimizePristineVariant -> do
- isrepo <- liftIO $ doesDirectoryExist (origrepo </> "_darcs")
- unless isrepo $ fail $ origrepo ++ ": Not a darcs repository!"
- variant_isrepo <- liftIO $ doesDirectoryExist (variant_repo </> "_darcs")
- unless variant_isrepo $ do
- echo $ "Setting up " ++ vDescription v ++ " variant of " ++ origrepo
- verbose ("cp -a '" ++ origrepo ++ "' '" ++ variant_repo ++ "'")
- liftIO $ copyTree origrepo variant_repo
- verbose ("# sanitize " ++ variant_repo)
- liftIO $ removeFile (sources variant_repo) `catch` \_ -> return ()
- darcs darcs_path [ "optimize", "--pristine", "--repodir", variant_repo ]
- return ()
- DefaultVariant -> return ()
+mkVariant origrepo darcs_path v = do
+ isrepo <- liftIO $ doesDirectoryExist (origrepo </> "_darcs")
+ unless isrepo $ fail $ origrepo ++ ": Not a darcs repository!"
+ case vId v of
+ OptimizePristineVariant -> do
+ variant_isrepo <- liftIO $ doesDirectoryExist (variant_repo </> "_darcs")
+ unless variant_isrepo $ do
+ echo $ "Setting up " ++ vDescription v ++ " variant of " ++ origrepo
+ verbose ("cp -a '" ++ origrepo ++ "' '" ++ variant_repo ++ "'")
+ liftIO $ copyTree origrepo variant_repo
+ verbose ("# sanitize " ++ variant_repo)
+ liftIO $ removeFile (sources variant_repo) `catch` \_ -> return ()
+ darcs darcs_path [ "optimize", "--pristine", "--repodir", variant_repo ]
+ return ()
+ GitVariant -> do
+ variant_exists <- liftIO $ doesDirectoryExist (variant_repo </> ".git")
+ unless variant_exists $ do
+ liftIO $ prepareTailor origrepo variant_repo "git"
+ liftIO $ system "tailor -c _tailor/config"
+ return ()
+ DefaultVariant -> return ()
where
variant_repo = variantRepoName v origrepo
hunk ./Definitions.hs 109
showJSON = error "showJSON not defined for TestRepo yet"
-- note that the order of the variants is reflected in the tables
-data VariantName = DefaultVariant | OptimizePristineVariant
+data VariantName = DefaultVariant | OptimizePristineVariant | GitVariant
deriving (Enum, Bounded, Eq, Ord, Read, Show)
instance JSON VariantName where
hunk ./Definitions.hs 116
readJSON (JSString s) =
case fromJSString s of
"optimize-pristine" -> return OptimizePristineVariant
+ "git" -> return GitVariant
x -> fail $ "Unknown variant: " ++ x
readJSON _ = fail "Unable to VariantName"
showJSON = error "showJSON not defined for VariantName yet"
hunk ./Definitions.hs 133
Variant n "default" "default (hashed)" ""
toVariant n...@optimizepristinevariant =
Variant n "opt pris" "optimize --pristine" "op"
+toVariant n...@gitvariant =
+ Variant n "git" "git" "git"
-- | Given a name of a repo like "tabular opt pris", figure out what the
-- variant was. If there are no suffixes, like "opt pris", we assume
[Improve tailor conversion resilience a bit.
Petr Rockai <[email protected]>**20100728214514
Ignore-this: 5913d1414c4f202ee310c284e25ca9c7
] hunk ./Benchmark.hs 240
, "[darcs:source]"
, "repository = " ++ (wd </> from)
, "subdir = checkout"
+ , "replace-badchars = " ++ badchars_fmt
+ , "init-options = --hashed"
, ""
, "[" ++ target ++ ":target]"
, "subdir = ../" ++ to ]
hunk ./Benchmark.hs 245
+ badchars_fmt = "{ " ++ intercalate "," (map badchar badchars) ++ " }"
+ badchar (x, y) = "'" ++ x ++ "': '" ++ y ++ "'"
+ badchars = [("\\x08", "X"),
+ ("\\x1b", "X"),
+ ("\\xc1", "Á"),
+ ("\\xc9", "É"),
+ ("\\xcd", "Í"),
+ ("\\xd3", "Ó"),
+ ("\\xd6", "Ö"),
+ ("\\xd5", "Ő"),
+ ("\\xda", "Ú"),
+ ("\\xdc", "Ü"),
+ ("\\xdb", "Ű"),
+ ("\\xe1", "á"),
+ ("\\xe9", "é"),
+ ("\\xed", "í"),
+ ("\\xf3", "ó"),
+ ("\\xf6", "ö"),
+ ("\\xf5", "ő"),
+ ("\\xfa", "ú"),
+ ("\\xfc", "ü"),
+ ("\\xfb", "ű"),
+ ("\\xf1", "ñ"),
+ ("\\xdf", "ß"),
+ ("\\xe5", "å")]
mkVariant :: String -> String -> Variant -> Command ()
mkVariant origrepo darcs_path v = do
[Keep track of exact versions of test binaries.
Petr Rockai <[email protected]>**20100806232955
Ignore-this: 49bfd3d2330b7635a6faf1e7afaff585
] hunk ./Benchmark.hs 7
import Shellish hiding ( run )
import Data.Char
import Data.List
-import Data.List.Split ( wordsBy )
+import Data.Maybe
+import Data.List.Split ( splitOn )
import System.Directory
import System.Environment
import System.FilePath( (</>), (<.>), splitDirectories, joinPath )
hunk ./Benchmark.hs 25
waitForProcess )
import System.Cmd( system )
import qualified System.IO.UTF8 as UTF8
+import qualified Data.ByteString.Char8 as BS
copyTree :: FilePath -> FilePath -> IO ()
copyTree from to =
hunk ./Benchmark.hs 103
iters_enough = iters_max - iters_min
run :: Test a -> Command (Maybe MemTimeOutput)
-run test@(Test benchmark tr (TestBinary bin)) = do
+run test@(Test benchmark tr bin) = do
(Just `fmap` run') `catchError` \e ->
do echo_n_err $ " error: " ++ show e
return Nothing
hunk ./Benchmark.hs 108
where run' = do
- progress $ bin ++ " " ++ description benchmark ++ " [" ++ trName tr ++ "]: "
- verbose $ "\n# testing; binary = " ++ bin ++ ", benchmark = " ++
+ progress $ cmd ++ " " ++ description benchmark ++ " [" ++ trName tr ++ "]: "
+ verbose $ "\n# testing; binary = " ++ cmd ++ ", benchmark = " ++
description benchmark ++ ", repository = " ++ trName tr
hunk ./Benchmark.hs 111
- exe <- which $ bin
+ exe <- which cmd
darcs_path <- case exe of
hunk ./Benchmark.hs 113
- Nothing -> canonize bin
+ Nothing -> canonize cmd
Just p -> return p
times <- adaptive 10 (3,100) . sub $ do
prepareIfDifferent (trPath tr)
hunk ./Benchmark.hs 121
m <- timed (exec benchmark darcs_path tr)
return m
let result = mkMemTimeOutput times
- spaces = 45 - (length bin + length (description benchmark) + length (trName tr))
+ spaces = 45 - (length cmd + length (description benchmark) + length (trName tr))
tu = appropriateUnit (mtTimeMean result)
result_str = unwords $ concatMap (\f -> f tu (Cell result)) [ formatTimeResult, formatMemoryResult, formatSampleSize ]
liftIO $ appendResult test times
hunk ./Benchmark.hs 128
progress $ (replicate spaces ' ') ++ result_str ++ "\n"
verbose $ "# result: " ++ result_str
return result
+ cmd = binCommand bin
timed :: Command a -> Command MemTime
timed a = do
hunk ./Benchmark.hs 140
resetMemoryUsed
return $ MemTime (fromIntegral mem) (realToFrac $ diffUTCTime t2 t1)
-darcsVersion :: String -> IO Version
-darcsVersion cmd = do
- (_,outH,_,procH) <- runInteractiveCommand $ cmd ++ " --version"
+darcsMeta :: String -> [String] -> IO String
+darcsMeta cmd args = do
+ (_,outH,_,procH) <- runInteractiveProcess cmd args Nothing Nothing
out <- strictGetContents outH
_ <- waitForProcess procH
hunk ./Benchmark.hs 145
- return $ map read . wordsBy (== '.') . takeWhile (not . isSpace) $ out
+ return out
hunk ./Benchmark.hs 147
-check_darcs :: String -> IO ()
+check_darcs :: String -> IO TestBinary
check_darcs cmd = do
hunk ./Benchmark.hs 149
- out <- darcsVersion cmd
- case out of
- 2:_ -> return ()
+ version <- darcsMeta cmd ["--version"]
+ [info, context] <- splitOn "Context:\n\n" `fmap` darcsMeta cmd ["--exact-version"]
+ rts <- read `fmap` darcsMeta cmd ["+RTS", "--info"]
+ let date = case info of
+ _ | "darcs compiled on" `isPrefixOf` info ->
+ drop 18 . takeWhile (/='\n') $ info
+ _ -> "<unknown date>"
+ bin = TestBinary { binCommand = cmd
+ , binVersionString = takeWhile (/='\n') version
+ , binDate = date
+ , binGHC = fromMaybe "unknown" $ lookup "GHC version" rts
+ , binContext = BS.pack context }
+ case binVersion bin of
+ 2:_ -> return bin
_ -> fail $ cmd ++ ": Not darcs 2.x binary."
verbose :: String -> Command ()
hunk ./Benchmark.hs 285
("\\xdf", "ß"),
("\\xe5", "å")]
-mkVariant :: String -> String -> Variant -> Command ()
-mkVariant origrepo darcs_path v = do
+mkVariant :: String -> TestBinary -> Variant -> Command ()
+mkVariant origrepo bin v = do
isrepo <- liftIO $ doesDirectoryExist (origrepo </> "_darcs")
unless isrepo $ fail $ origrepo ++ ": Not a darcs repository!"
case vId v of
hunk ./Benchmark.hs 298
liftIO $ copyTree origrepo variant_repo
verbose ("# sanitize " ++ variant_repo)
liftIO $ removeFile (sources variant_repo) `catch` \_ -> return ()
- darcs darcs_path [ "optimize", "--pristine", "--repodir", variant_repo ]
+ darcs (binCommand bin) [ "optimize", "--pristine", "--repodir", variant_repo ]
return ()
GitVariant -> do
variant_exists <- liftIO $ doesDirectoryExist (variant_repo </> ".git")
hunk ./Benchmark.hs 319
| otherwise = y
setupVariants :: [TestRepo] -> TestBinary -> Command ()
-setupVariants repos (TestBinary bin) =
+setupVariants repos bin =
sequence_ [ mkVariant (trPath repo) bin variant
| repo <- repos, variant <- trVariants repo ]
hunk ./Definitions.hs 3
module Definitions where
+import Prelude hiding ( readFile )
+import System.IO.Strict( readFile )
import Control.Applicative
import Data.Array.Vector
import Data.Function
hunk ./Definitions.hs 10
import Data.IORef
import Data.List
+import Data.List.Split ( wordsBy, splitOn )
import Data.Maybe
import Data.Ord
import Data.Time
hunk ./Definitions.hs 14
+import Data.Digest.Pure.SHA
import Network.BSD ( HostName, getHostName )
import Statistics.Sample
import System.Directory
hunk ./Definitions.hs 23
import System.IO.Unsafe
import Text.JSON
import Text.Printf
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy.Char8 as BL
import Shellish (Command)
hunk ./Definitions.hs 32
data Test a = Test (Benchmark a) TestRepo TestBinary deriving (Show)
-data TestBinary = TestBinary String deriving (Show, Eq)
+data TestBinary = TestBinary { binCommand :: String
+ , binVersionString :: String
+ , binDate :: String
+ , binGHC :: String
+ , binContext :: BS.ByteString }
+ deriving (Eq, Show, Read)
+
+binVersion :: TestBinary -> [Int]
+binVersion = parsever . binVersionString
+ where parsever = map read . wordsBy (== '.') . takeWhile (not . isSpace)
+
+binSha1 :: TestBinary -> String
+binSha1 bin = showDigest (sha1 $ BL.fromChunks [BS.pack txt, binContext bin])
+ where txt = show (binVersionString bin) ++ " " ++ binDate bin ++ " "
data ParamStamp = Params { pHostName :: HostName
, pFlush :: Maybe (FilePath -> IO ()) }
hunk ./Definitions.hs 200
do d <- resultsDir
return $ d </> paramStampPath cstmp <.> "timings"
+appendBinary :: TestBinary -> IO ()
+appendBinary bin =
+ do (pstmp, _) <- readIORef global
+ path <- flip replaceExtension "info" `fmap` timingsDir pstmp
+ current <- (read `fmap` readFile path) `catch` \_ -> return []
+ let new = (sha, bin) : [ (s, x) | (s, x) <- current, s /= sha ]
+ writeFile path (show new)
+ where sha = binSha1 bin
+
appendResult :: Test a -> [MemTime] -> IO ()
hunk ./Definitions.hs 210
-appendResult (Test benchmark tr (TestBinary bin)) times =
+appendResult (Test benchmark tr bin) times =
do (pstmp, tstmp) <- readIORef global
d <- resultsDir
createDirectoryIfMissing False d
hunk ./Definitions.hs 219
appendFile (td </> timeStampPath tstmp) block
where
block = unlines $ map (intercalate "\t" . fields) times
- fields mt = [ trName tr, bin, description benchmark ] ++ fieldMt mt
+ fields mt = [ trName tr, binSha1 bin, description benchmark ] ++ fieldMt mt
fieldMt (MemTime m t) = [ show (fromRational m :: Float), show t ]
-- ----------------------------------------------------------------------
hunk ./Definitions.hs 272
--
columns repo = map mkColName $ columnInfos repo
columnInfos repo = nub [ (b, trName tr) | (Test _ tr b, _) <- repo ]
- mkColName (TestBinary b, tname) =
+ mkColName (b, tname) =
let v = nameToVariant tname
prefix = case vId v of
DefaultVariant -> ""
hunk ./Definitions.hs 277
_-> vSuffix v ++ " "
- in prefix ++ cutdown b
+ in prefix ++ cutdown (binCommand b)
cutdown d | "darcs-" `isPrefixOf` d = cutdown (drop 6 d)
| takeExtension d == ".exe" = dropExtension d
| otherwise = d
hunk ./Report.hs 52
where
isTimingFile f = takeExtension f == ".timings"
+-- | Map an sha1 of darcs binary into the original binary description.
+readInfos :: String -> (String -> TestBinary)
+readInfos bits = \x -> fromJust $ lookup x (read bits)
+
readTimingsForParams :: String -> IO [(Test a, Maybe MemTimeOutput)]
readTimingsForParams pstamp = do
rdir <- resultsDir
hunk ./Report.hs 60
let pdir = rdir </> pstamp <.> "timings"
- -- let ifile = replaceExtension ".timings" ".info" pdir
+ ifile = rdir </> pstamp <.> "info"
+ infos <- readInfos `fmap` readFile ifile
tfiles <- filter notJunk `fmap` getDirectoryContents pdir
entries <- concat `fmap` mapM parseTimingsFile (map (pdir </>) tfiles)
hunk ./Report.hs 64
- return . map process . Map.toList . Map.fromListWith (++) . map (second (:[])) $ entries
+ return . map (process infos) . Map.toList . Map.fromListWith (++) . map (second (:[])) $ entries
where
notJunk = not . (`elem` [".",".."])
hunk ./Report.hs 68
-process :: ((String, String, String), [MemTime]) -> (Test a, Maybe MemTimeOutput)
-process ((repo, dbin, bm), times) = (key, val)
+process :: (String -> TestBinary)
+ -> ((String, String, String), [MemTime]) -> (Test a, Maybe MemTimeOutput)
+process infos ((repo, binhash, bm), times) = (key, val)
where
hunk ./Report.hs 72
- key = Test (Description bm) (mkTr repo) (TestBinary dbin)
+ key = Test (Description bm) (mkTr repo) (infos binhash)
val = Just $ mkMemTimeOutput times
mkTr n = TestRepo n (guessCoreName n) n Nothing [] []
hunk ./Report.hs 109
-- ----------------------------------------------------------------------
renderMany :: [(Test a, Maybe MemTimeOutput)] -> Command ()
-renderMany results = do
+renderMany results = do
echo . unlines $
hunk ./Report.hs 111
- [ "Copy and paste below"
+ [ "Benchmark Results"
, "====================================================="
, ""
, machine_details
hunk ./Report.hs 126
, def "sdev" "std deviation"
, descriptions_of_variants
, ""
+ , binary_details
+ , ""
, "Timing Graphs"
, "===================================================="
, ""
hunk ./Report.hs 149
tables = repoTables benchmarks results
--
machine_details = intercalate "\n" $
- map detail [ "GHC version"
- , "Machine description", "Year", "CPU", "Memory", "Hard disk"
- , "Notes" ]
+ map detail [ "Machine description", "Year", "CPU", "Memory", "Hard disk", "Notes" ]
detail k = k ++ "\n *Replace Me*"
--
descriptions_of_variants = intercalate "\n" $
hunk ./Report.hs 172
, ""
] ++ (map imgDirective gs) ++ [""]
imgDirective = (".. image:: " ++)
+ binaries = nub [ bin | (Test _ _ bin, _) <- results ]
+ --
+ binary_details = unlines $ map describe_bin binaries
+ describe_bin bin = padl 12 (binCommand bin ++ ": ") ++
+ binVersionString bin ++ ",\n" ++ (replicate 12 ' ') ++
+ binDate bin ++ ", GHC " ++ binGHC bin
+ padr n x = x ++ pad n x
+ padl n x = pad n x ++ x
+ pad n x = take (n - length x) (repeat ' ')
printCumulativeReport :: Command ()
printCumulativeReport = do
hunk ./Run.hs 14
benchMany :: [(TestRepo, [Benchmark a])] -> [TestBinary] -> Command [(Test a, Maybe MemTimeOutput)]
benchMany reposbenches bins = do
- binsVers <- liftIO $ forM bins $
- \bin@(TestBinary b) -> do v <- darcsVersion b
- return (bin, v)
fmap concat $ forM reposbenches $ \(r,benches) -> do
res <- sequence
[ do let test = Test bench repo bin
hunk ./Run.hs 19
memtime <- run test
return (test, memtime)
- | (bin,ver) <- binsVers
- , repo <- repoAndVariants ver r
+ | bin <- bins
+ , repo <- repoAndVariants (binVersion bin) r
, bench <- filter (noSkip r) benches ]
case repoTables benchmarks res of
[] -> echo "No benchmarks were run"
hunk ./darcs-benchmark.cabal 41
split == 0.1.*,
utf8-string == 0.3.*,
hs-gchart,
- tar, zlib
+ tar, zlib, SHA
main-is: main.hs
other-modules: Shellish
hunk ./main.hs 56
system $ path ++ " --version > /dev/null"
return ()
-config :: [TestRepo] -> C.Config -> IO ([(TestRepo,[Benchmark ()])], [TestBinary])
+config :: [TestRepo] -> C.Config -> IO ([(TestRepo,[Benchmark ()])], [String])
config allrepos cfg = do
case cfg of
Get {} -> do
hunk ./main.hs 76
confbins = if length conf > 0 then words $ conf !! 0 else []
(bins,repos) = second (drop 1) $ break (== "/") (C.extra cfg)
userepos = if null repos then confrepos else repos
- usebins = map TestBinary $ if null bins then confbins else bins
+ usebins = if null bins then confbins else bins
usetests' = if C.fast cfg then filter (\b -> speed b == FastB) benchmarks else benchmarks
usetests = case C.only cfg of
[] -> usetests'
hunk ./main.hs 117
, "repo." `isPrefixOf` d
, d `notElem` map trPath configs ]
return (configs ++ other)
- (reposNtests, binaries) <- config allrepos cfg
+ (reposNtests, binaries') <- config allrepos cfg
let repos = map fst reposNtests
unless (null $ repos \\ allrepos) $ do
let name r = intercalate ", " $ map trName r
hunk ./main.hs 123
putStrLn $ "Missing repositories: " ++ name (repos \\ allrepos)
exitWith $ ExitFailure 2
- forM_ binaries $ \(TestBinary bin) -> check_darcs bin
+ binaries <- forM binaries' check_darcs
+ mapM_ appendBinary binaries
when (null repos) $ do
putStrLn $ "Oops, no repositories! Consider doing a darcs-benchmark get."
putStrLn $ "(Alternatively, check that you are in the right directory.)"
[Disambiguate different binaries with same name in reports.
Petr Rockai <[email protected]>**20100806235443
Ignore-this: fdca4a24d7f491a2552414435b04918
] hunk ./Benchmark.hs 8
import Data.Char
import Data.List
import Data.Maybe
+import Data.DateTime( parseDateTime, startOfTime )
import Data.List.Split ( splitOn )
import System.Directory
import System.Environment
hunk ./Benchmark.hs 153
version <- darcsMeta cmd ["--version"]
[info, context] <- splitOn "Context:\n\n" `fmap` darcsMeta cmd ["--exact-version"]
rts <- read `fmap` darcsMeta cmd ["+RTS", "--info"]
- let date = case info of
+ let date' = case info of
_ | "darcs compiled on" `isPrefixOf` info ->
drop 18 . takeWhile (/='\n') $ info
_ -> "<unknown date>"
hunk ./Benchmark.hs 157
+ date = fromMaybe startOfTime $ parseDateTime "%b %e %Y, at %H:%M:%S" date'
bin = TestBinary { binCommand = cmd
, binVersionString = takeWhile (/='\n') version
, binDate = date
hunk ./Definitions.hs 12
import Data.List
import Data.List.Split ( wordsBy, splitOn )
import Data.Maybe
+import Data.DateTime( DateTime, formatDateTime )
import Data.Ord
import Data.Time
import Data.Digest.Pure.SHA
hunk ./Definitions.hs 35
data TestBinary = TestBinary { binCommand :: String
, binVersionString :: String
- , binDate :: String
+ , binDate :: DateTime
, binGHC :: String
, binContext :: BS.ByteString }
hunk ./Definitions.hs 38
- deriving (Eq, Show, Read)
+ deriving (Eq, Ord, Show, Read)
binVersion :: TestBinary -> [Int]
binVersion = parsever . binVersionString
hunk ./Definitions.hs 46
binSha1 :: TestBinary -> String
binSha1 bin = showDigest (sha1 $ BL.fromChunks [BS.pack txt, binContext bin])
- where txt = show (binVersionString bin) ++ " " ++ binDate bin ++ " "
+ where txt = show (binVersionString bin) ++ " " ++
+ (formatDateTime "%Y-%m-%d %H:%M:%S" $ binDate bin) ++ " "
data ParamStamp = Params { pHostName :: HostName
, pFlush :: Maybe (FilePath -> IO ()) }
hunk ./Report.hs 9
import Data.List
import Data.List.Split
import Data.Maybe
+import Data.DateTime( formatDateTime )
import qualified Data.Map as Map
import qualified Text.Tabular as Tab
import System.Directory
hunk ./Report.hs 55
-- | Map an sha1 of darcs binary into the original binary description.
readInfos :: String -> (String -> TestBinary)
-readInfos bits = \x -> fromJust $ lookup x (read bits)
+readInfos bits = \x -> fromJust $ lookup x table
+ where table' = sortBy order (read bits)
+ ids = [ id | (id:_:_) <- group . sort $ map (binCommand . snd) table' ]
+ fixid n id ((sha, bin):rem)
+ | binCommand bin == id = (sha, bin { binCommand = id ++ " " ++ show n }) :
+ fixid (n + 1) id rem
+ | otherwise = (sha, bin) : fixid n id rem
+ fixid _ _ [] = []
+ table = (foldl (.) id (map (fixid 0) ids)) table'
+ order (_, x) (_, y) = case compare (binVersion x) (binVersion y) of
+ EQ -> compare (binDate x) (binDate y)
+ ord -> ord
readTimingsForParams :: String -> IO [(Test a, Maybe MemTimeOutput)]
readTimingsForParams pstamp = do
hunk ./Report.hs 184
, ""
] ++ (map imgDirective gs) ++ [""]
imgDirective = (".. image:: " ++)
- binaries = nub [ bin | (Test _ _ bin, _) <- results ]
+ binaries = map head . group . sort $ [ bin | (Test _ _ bin, _) <- results ]
--
binary_details = unlines $ map describe_bin binaries
describe_bin bin = padl 12 (binCommand bin ++ ": ") ++
hunk ./Report.hs 189
binVersionString bin ++ ",\n" ++ (replicate 12 ' ') ++
- binDate bin ++ ", GHC " ++ binGHC bin
+ (formatDateTime "%Y-%m-%d %H:%M:%S" $ binDate bin) ++
+ ", GHC " ++ binGHC bin
padr n x = x ++ pad n x
padl n x = pad n x ++ x
pad n x = take (n - length x) (repeat ' ')
hunk ./darcs-benchmark.cabal 41
split == 0.1.*,
utf8-string == 0.3.*,
hs-gchart,
- tar, zlib, SHA
+ tar, zlib, SHA, datetime
main-is: main.hs
other-modules: Shellish
Context:
[Bump version to 0.1.9.
Eric Kow <[email protected]>**20100731121722
Ignore-this: 93c3ce4b6bfb391305ccbd11271ae37f
]
[Add ability for a repo to specify tests to skip.
Eric Kow <[email protected]>**20100731121406
Ignore-this: 3ca82443a2e86062202ca8311fbcea4c
]
[Resolve #ead: was fixed in darcs-benchmark 0.1.8
Eric Kow <[email protected]>**20100731120101
Ignore-this: fb440fa86d9cbae2c857c91510183225
]
[Report timings as mean plus one standard deviation.
Eric Kow <[email protected]>**20100731114503
Ignore-this: 97a05bc0cb31cc33b21150f311775352
Quoting Zooko:
My intuition is that I'd rather have something that's sort of fast
almost every time than something that's really fast half the time and
slow half the time, even if the latter thing has a better mean.
Zed Shaw has also written a blog entry claiming that people will tend to notice
variance, so (my reading of his post), if something has a good mean time but
jumps around a lot, the worst case could stick in people's minds a lot more.
It doesn't make sense to report the worst case (because of outliers), but we
could at least use the stddev to nudge us a bit closer in that direction.
]
[Avoid a bug where we think we have sufficient data for tests we never ran.
Eric Kow <[email protected]>**20100731114457
Ignore-this: 90a341fdb8d9d1bd31bd16fc02ec79b2
]
[Correctly report when we don't run any benchmarks.
Eric Kow <[email protected]>**20100731114451
Ignore-this: 9c16a01de634b7cda7cfb7e7965672ca
]
[run --converge feature to only run benchmarks with insufficient data.
'Eric Kow <[email protected]>'**20100731100655
Ignore-this: 4a5ea5cef09c66a83d3464d6dc574fe0
This involves changing darcs-benchmark to support having a separate list
of benchmarks to run for each repository.
]
[Emphasise graphs in report.
'Eric Kow <[email protected]>'**20100729071939
Ignore-this: 270fc9800b7cca5e978d557ff40317b4
]
[TAG 0.1.8.3
Eric Kow <[email protected]>**20100725233519
Ignore-this: 22bca35e28147d3af7aa93c9c8d14719
]
[Bump version to 0.1.8.3.
'Eric Kow <[email protected]>'**20100725232918
Ignore-this: 19b8845cc89d894c4bb14856c3e876bc
]
[Fix a file descriptor leak from reading the stats files.
'Eric Kow <[email protected]>'**20100725232838
Ignore-this: 451892c53cad274feccd69d5a1b3f003
]
[Resolve #3e0: darcs version threshold for variants
'Eric Kow <[email protected]>'**20100725230625
Ignore-this: c4fc4b03b7630aa6f86fb57416d9f441
]
[Open #00a: use criterion for better handle of statistics.
'Eric Kow <[email protected]>'**20100725214249
Ignore-this: 4c9563ceab9a1ce06994e695e338d933
]
[TAG 0.1.8.2
Eric Kow <[email protected]>**20100725214220
Ignore-this: 91e211376e0d498b8cb3ed1255def6f
]
[Bump version to 0.1.8.2.
'Eric Kow <[email protected]>'**20100724205608
Ignore-this: a6a934499538422c642a117c214f5187
]
[Restrict column matching in repoTables to per-repo
Max Battcher <[email protected]>**20100722080058
Ignore-this: 88d0e6ccf1dcb446a90e478fc355fb38
]
[Replace machine_details filler string with some that works in reST
Max Battcher <[email protected]>**20100722075321
Ignore-this: 612938597d9ed778b5863968daac3220
]
[TAG 0.1.8.1
Eric Kow <[email protected]>**20100718160418
Ignore-this: ea116125804b2e64bed5e2967ca9c010
]
Patch bundle hash:
ac11f77ada46e5960c681a753db3490a2a3be2be
_______________________________________________
darcs-users mailing list
[email protected]
http://lists.osuosl.org/mailman/listinfo/darcs-users
