Unverified Commit ff0a83fc authored by Oleg Grenrus's avatar Oleg Grenrus Committed by GitHub
Browse files

Merge pull request #7114 from phadej/solver-benchmarks-concurrently

Add --concurrently to solver-benchmarks
parents ae27de48 47ec6c46
...@@ -14,6 +14,7 @@ module HackageBenchmark ( ...@@ -14,6 +14,7 @@ module HackageBenchmark (
, shouldContinueAfterFirstTrial , shouldContinueAfterFirstTrial
) where ) where
import Control.Concurrent.Async (concurrently)
import Control.Monad (forM, replicateM, unless, when) import Control.Monad (forM, replicateM, unless, when)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.List (nub, unzip4) import Data.List (nub, unzip4)
...@@ -52,6 +53,7 @@ data Args = Args { ...@@ -52,6 +53,7 @@ data Args = Args {
, argMinRunTimeDifferenceToRerun :: Double , argMinRunTimeDifferenceToRerun :: Double
, argPValue :: PValue Double , argPValue :: PValue Double
, argTrials :: Int , argTrials :: Int
, argConcurrently :: Bool
, argPrintTrials :: Bool , argPrintTrials :: Bool
, argPrintSkippedPackages :: Bool , argPrintSkippedPackages :: Bool
, argTimeoutSeconds :: Int , argTimeoutSeconds :: Int
...@@ -81,6 +83,10 @@ hackageBenchmarkMain = do ...@@ -81,6 +83,10 @@ hackageBenchmarkMain = do
pkgs <- getPackages args pkgs <- getPackages args
putStrLn "" putStrLn ""
let concurrently' :: IO a -> IO b -> IO (a, b)
concurrently' | argConcurrently = concurrently
| otherwise = \ma mb -> do { a <- ma; b <- mb; return (a, b) }
let -- The maximum length of the heading and package names. let -- The maximum length of the heading and package names.
nameColumnWidth :: Int nameColumnWidth :: Int
nameColumnWidth = nameColumnWidth =
...@@ -106,8 +112,7 @@ hackageBenchmarkMain = do ...@@ -106,8 +112,7 @@ hackageBenchmarkMain = do
(show result1) (show result2) (show result1) (show result2)
(diffTimeToDouble time1) (diffTimeToDouble time2) (diffTimeToDouble time1) (diffTimeToDouble time2)
CabalTrial t1 r1 <- runCabal1 pkg (CabalTrial t1 r1, CabalTrial t2 r2) <- runCabal1 pkg `concurrently'` runCabal2 pkg
CabalTrial t2 r2 <- runCabal2 pkg
if not $ if not $
shouldContinueAfterFirstTrial argMinRunTimeDifferenceToRerun t1 t2 r1 r2 shouldContinueAfterFirstTrial argMinRunTimeDifferenceToRerun t1 t2 r1 r2
...@@ -122,8 +127,8 @@ hackageBenchmarkMain = do ...@@ -122,8 +127,8 @@ hackageBenchmarkMain = do
when argPrintTrials $ printTrial "trial" r1 r2 t1 t2 when argPrintTrials $ printTrial "trial" r1 r2 t1 t2
(ts1, ts2, rs1, rs2) <- (unzip4 . ((t1, t2, r1, r2) :) <$>) (ts1, ts2, rs1, rs2) <- (unzip4 . ((t1, t2, r1, r2) :) <$>)
. replicateM (argTrials - 1) $ do . replicateM (argTrials - 1) $ do
CabalTrial t1' r1' <- runCabal1 pkg
CabalTrial t2' r2' <- runCabal2 pkg (CabalTrial t1' r1', CabalTrial t2' r2') <- runCabal1 pkg `concurrently'` runCabal2 pkg
when argPrintTrials $ printTrial "trial" r1' r2' t1' t2' when argPrintTrials $ printTrial "trial" r1' r2' t1' t2'
return (t1', t2', r1', r2') return (t1', t2', r1', r2')
...@@ -405,6 +410,9 @@ argParser = Args ...@@ -405,6 +410,9 @@ argParser = Args
<> value 10 <> value 10
<> metavar "N" <> metavar "N"
<> help "Number of trials for each package") <> help "Number of trials for each package")
<*> switch
( long "concurrently"
<> help "Run cabals concurrently")
<*> switch <*> switch
( long "print-trials" ( long "print-trials"
<> help "Whether to include the results from individual trials in the output") <> help "Whether to include the results from individual trials in the output")
......
...@@ -27,6 +27,7 @@ library ...@@ -27,6 +27,7 @@ library
exposed-modules: exposed-modules:
HackageBenchmark HackageBenchmark
build-depends: build-depends:
async >=2.2.2 && <2.3,
base, base,
bytestring, bytestring,
containers, containers,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment