darcs-benchmark 0.1.8.2 → 0.1.8.3

raw patch · 4 files changed

+34/−9 lines, 4 files

Files

• Benchmark.hs +15/−4
• Definitions.hs +10/−0
• Run.hs +6/−3
• darcs-benchmark.cabal +3/−2

@@ -2,7 +2,9 @@  import Definitions import Shellish hiding ( run )+import Data.Char import Data.List+import Data.List.Split ( wordsBy ) import System.Directory import System.Environment import System.FilePath( (</>), (<.>), splitDirectories, joinPath )@@ -131,13 +133,18 @@   resetMemoryUsed   return $ MemTime (fromIntegral mem) (realToFrac $ diffUTCTime t2 t1) -check_darcs :: String -> IO ()-check_darcs cmd = do+darcsVersion :: String -> IO Version+darcsVersion cmd = do        (_,outH,_,procH) <- runInteractiveCommand $ cmd ++ " --version"        out <- strictGetContents outH        _ <- waitForProcess procH+       return $ map read . wordsBy (== '.') . takeWhile (not . isSpace) $ out++check_darcs :: String -> IO ()+check_darcs cmd = do+       out <- darcsVersion cmd        case out of-         '2':'.':_ -> return ()+         2:_ -> return ()          _ -> fail $ cmd ++ ": Not darcs 2.x binary."  verbose :: String -> Command ()@@ -157,6 +164,10 @@                   _ <- forkIO $ work ""                   return chan +readFile' :: FilePath -> IO String+readFile' f = do s <- readFile f+                 length s `seq` return s+ darcs :: String -> [String] -> Command String darcs cmd args' = do     stats_f <- liftIO $@@ -176,7 +187,7 @@        res' <- drain outH loud        errs' <- drain errH loud        ex <- waitForProcess procH-       stats <- do c <- readFile stats_f+       stats <- do c <- readFile' stats_f                    removeFile stats_f `catch` \e -> hPutStrLn stderr (show e)                    return c                 `catch` \_ -> return ""

@@ -29,6 +29,10 @@                          , pFlush :: Maybe (FilePath -> IO ()) } type TimeStamp = UTCTime +type Version = [Int] -- we could also use Data.Version+                     -- the difference here is just that we explicitly+                     -- do not have a notion of version tags+ global :: IORef (ParamStamp, TimeStamp) global = unsafePerformIO $ do t  <- getCurrentTime                               hn <- getHostName@@ -139,6 +143,12 @@  allVariants :: [Variant] allVariants = map toVariant [minBound .. maxBound]++-- | The subset of variants appropriate to the given darcs version+appropriateVariants :: Version -> [Variant] -> [Variant]+appropriateVariants v | v < [2,3,97] = filter ((/= OptimizePristineVariant) . vId)+                      | v > [2,4,96] = filter ((/= DefaultVariant) . vId)+                      | otherwise    = id  -- ---------------------------------------------------------------------- -- long-term storage

@@ -11,19 +11,22 @@  benchMany :: [TestRepo] -> [TestBinary] -> [Benchmark a] -> Command [(Test a, Maybe MemTimeOutput)] benchMany repos bins benches = do-  fmap concat $ forM (map repoAndVariants repos) $ \rs -> do+  binsVers <- liftIO $ forM bins $+    \bin@(TestBinary b) -> do v <- darcsVersion b+                              return (bin, v)+  fmap concat $ forM repos $ \r -> do     res <- sequence              [ do let test = Test bench repo bin                   memtime <- run test                   return (test, memtime)-               | repo <- rs, bin <- bins, bench <- benches ]+               | (bin,ver) <- binsVers, repo <- repoAndVariants ver r, bench <- benches ]     let tables = repoTables benchmarks res     if length tables == 1 then       echo_n $ TR.render id id id $ tabulateRepo formatTimeResult (head tables)       else error "Not expecting more than one table for a repo and its variants"     return res  where-  repoAndVariants r = map (r `tweakVia`) (trVariants r)+  repoAndVariants v r = map (r `tweakVia`) (appropriateVariants v (trVariants r))   tweakVia tr v =    case vId v of      DefaultVariant -> tr

@@ -1,5 +1,5 @@ name:          darcs-benchmark-version:       0.1.8.2+version:       0.1.8.3 synopsis:      Comparative benchmark suite for darcs.  description: A simple tool to compare performance of different Darcs 2.x@@ -22,7 +22,8 @@ executable darcs-benchmark     if impl(ghc >= 6.8)       ghc-options: -fwarn-tabs-    ghc-options:   -Wall -threaded++    ghc-options:   -Wall -threaded -fno-warn-unused-do-bind     ghc-prof-options: -prof -auto-all -threaded      build-depends: base < 5,