Commit 203421c5 authored by Mikhail Glushenkov's avatar 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
......@@ -134,7 +134,7 @@ import Distribution.Version
import Distribution.Simple.Utils as Utils
( notice, info, warn, debugNoWrap, die, intercalate, withTempDirectory )
import Distribution.Client.Utils
( numberOfProcessors, inDir, mergeBy, MergeResult(..)
( determineNumJobs, 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
......
......@@ -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
......
......@@ -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
......
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