Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
203421c5
Commit
203421c5
authored
Sep 26, 2013
by
Mikhail Glushenkov
Browse files
Set the # of jobs to the # of cores for 'build/test/bench/run -j'.
We do this for 'install -j' already.
parent
e378d71c
Changes
3
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/Install.hs
View file @
203421c5
...
...
@@ -134,7 +134,7 @@ import Distribution.Version
import
Distribution.Simple.Utils
as
Utils
(
notice
,
info
,
warn
,
debugNoWrap
,
die
,
intercalate
,
withTempDirectory
)
import
Distribution.Client.Utils
(
numberOfProcessor
s
,
inDir
,
mergeBy
,
MergeResult
(
..
)
(
determineNumJob
s
,
inDir
,
mergeBy
,
MergeResult
(
..
)
,
tryCanonicalizePath
)
import
Distribution.System
(
Platform
,
OS
(
Windows
),
buildOS
)
...
...
@@ -904,10 +904,7 @@ performInstallations verbosity
platform
=
InstallPlan
.
planPlatform
installPlan
compid
=
InstallPlan
.
planCompiler
installPlan
numJobs
=
case
installNumJobs
installFlags
of
Cabal
.
NoFlag
->
1
Cabal
.
Flag
Nothing
->
numberOfProcessors
Cabal
.
Flag
(
Just
n
)
->
n
numJobs
=
determineNumJobs
(
installNumJobs
installFlags
)
numFetchJobs
=
2
parallelBuild
=
numJobs
>=
2
...
...
cabal-install/Distribution/Client/Utils.hs
View file @
203421c5
...
...
@@ -2,7 +2,7 @@
module
Distribution.Client.Utils
(
MergeResult
(
..
)
,
mergeBy
,
duplicates
,
duplicatesBy
,
inDir
,
numberOfProcessors
,
inDir
,
determineNumJobs
,
numberOfProcessors
,
removeExistingFile
,
makeAbsoluteToCwd
,
filePathToByteString
,
byteStringToFilePath
,
tryCanonicalizePath
...
...
@@ -10,6 +10,7 @@ module Distribution.Client.Utils ( MergeResult(..)
where
import
Distribution.Compat.Exception
(
catchIO
)
import
Distribution.Simple.Setup
(
Flag
(
..
)
)
import
qualified
Data.ByteString.Lazy
as
BS
import
Control.Monad
(
when
)
...
...
@@ -88,6 +89,14 @@ foreign import ccall "getNumberOfProcessors" c_getNumberOfProcessors :: IO CInt
numberOfProcessors
::
Int
numberOfProcessors
=
fromEnum
$
unsafePerformIO
c_getNumberOfProcessors
-- | Determine the number of jobs to use given the value of the '-j' flag.
determineNumJobs
::
Flag
(
Maybe
Int
)
->
Int
determineNumJobs
numJobsFlag
=
case
numJobsFlag
of
NoFlag
->
1
Flag
Nothing
->
numberOfProcessors
Flag
(
Just
n
)
->
n
-- | Given a relative path, make it absolute relative to the current
-- directory. Absolute paths are returned unmodified.
makeAbsoluteToCwd
::
FilePath
->
IO
FilePath
...
...
cabal-install/Main.hs
View file @
203421c5
...
...
@@ -94,6 +94,7 @@ import Distribution.Client.Sandbox.Timestamp (maybeAddCompilerTimestampRecord)
import
Distribution.Client.Sandbox.Types
(
UseSandbox
(
..
),
whenUsingSandbox
)
import
Distribution.Client.Init
(
initCabal
)
import
qualified
Distribution.Client.Win32SelfUpgrade
as
Win32SelfUpgrade
import
Distribution.Client.Utils
(
determineNumJobs
)
import
Distribution.PackageDescription
(
Executable
(
..
)
)
...
...
@@ -265,8 +266,12 @@ configureAction (configFlags, configExFlags) extraArgs globalFlags = do
comp
platform
conf
configFlags''
configExFlags'
extraArgs
buildAction
::
(
BuildFlags
,
BuildExFlags
)
->
[
String
]
->
GlobalFlags
->
IO
()
buildAction
(
buildFlags
,
buildExFlags
)
extraArgs
globalFlags
=
do
let
distPref
=
fromFlagOrDefault
(
useDistPref
defaultSetupScriptOptions
)
buildAction
(
buildFlags'
,
buildExFlags
)
extraArgs
globalFlags
=
do
let
buildFlags
=
buildFlags'
{
buildNumJobs
=
Flag
.
Just
.
determineNumJobs
.
buildNumJobs
$
buildFlags'
}
distPref
=
fromFlagOrDefault
(
useDistPref
defaultSetupScriptOptions
)
(
buildDistPref
buildFlags
)
verbosity
=
fromFlagOrDefault
normal
(
buildVerbosity
buildFlags
)
noAddSource
=
fromFlagOrDefault
DontSkipAddSourceDepsCheck
...
...
@@ -623,8 +628,12 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
testAction
::
(
TestFlags
,
BuildFlags
,
BuildExFlags
)
->
[
String
]
->
GlobalFlags
->
IO
()
testAction
(
testFlags
,
buildFlags
,
buildExFlags
)
extraArgs
globalFlags
=
do
let
verbosity
=
fromFlagOrDefault
normal
(
testVerbosity
testFlags
)
testAction
(
testFlags
,
buildFlags'
,
buildExFlags
)
extraArgs
globalFlags
=
do
let
buildFlags
=
buildFlags'
{
buildNumJobs
=
Flag
.
Just
.
determineNumJobs
.
buildNumJobs
$
buildFlags'
}
verbosity
=
fromFlagOrDefault
normal
(
testVerbosity
testFlags
)
distPref
=
fromFlagOrDefault
(
useDistPref
defaultSetupScriptOptions
)
(
testDistPref
testFlags
)
setupOptions
=
defaultSetupScriptOptions
{
useDistPref
=
distPref
}
...
...
@@ -650,9 +659,13 @@ testAction (testFlags, buildFlags, buildExFlags) extraArgs globalFlags = do
benchmarkAction
::
(
BenchmarkFlags
,
BuildFlags
,
BuildExFlags
)
->
[
String
]
->
GlobalFlags
->
IO
()
benchmarkAction
(
benchmarkFlags
,
buildFlags
,
buildExFlags
)
benchmarkAction
(
benchmarkFlags
,
buildFlags
'
,
buildExFlags
)
extraArgs
globalFlags
=
do
let
verbosity
=
fromFlagOrDefault
normal
let
buildFlags
=
buildFlags'
{
buildNumJobs
=
Flag
.
Just
.
determineNumJobs
.
buildNumJobs
$
buildFlags'
}
verbosity
=
fromFlagOrDefault
normal
(
benchmarkVerbosity
benchmarkFlags
)
distPref
=
fromFlagOrDefault
(
useDistPref
defaultSetupScriptOptions
)
(
benchmarkDistPref
benchmarkFlags
)
...
...
@@ -808,8 +821,12 @@ reportAction reportFlags extraArgs globalFlags = do
(
flagToMaybe
$
reportPassword
reportFlags'
)
runAction
::
(
BuildFlags
,
BuildExFlags
)
->
[
String
]
->
GlobalFlags
->
IO
()
runAction
(
buildFlags
,
buildExFlags
)
extraArgs
globalFlags
=
do
let
verbosity
=
fromFlagOrDefault
normal
(
buildVerbosity
buildFlags
)
runAction
(
buildFlags'
,
buildExFlags
)
extraArgs
globalFlags
=
do
let
buildFlags
=
buildFlags'
{
buildNumJobs
=
Flag
.
Just
.
determineNumJobs
.
buildNumJobs
$
buildFlags'
}
verbosity
=
fromFlagOrDefault
normal
(
buildVerbosity
buildFlags
)
distPref
=
fromFlagOrDefault
(
useDistPref
defaultSetupScriptOptions
)
(
buildDistPref
buildFlags
)
noAddSource
=
fromFlagOrDefault
DontSkipAddSourceDepsCheck
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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