Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
ff0a83fc
Unverified
Commit
ff0a83fc
authored
Oct 11, 2020
by
Oleg Grenrus
Committed by
GitHub
Oct 11, 2020
Browse files
Merge pull request #7114 from phadej/solver-benchmarks-concurrently
Add --concurrently to solver-benchmarks
parents
ae27de48
47ec6c46
Changes
2
Show whitespace changes
Inline
Side-by-side
solver-benchmarks/HackageBenchmark.hs
View file @
ff0a83fc
...
@@ -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"
)
...
...
solver-benchmarks/solver-benchmarks.cabal
View file @
ff0a83fc
...
@@ -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,
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment