diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs index 459cee1bdea..a6009f012a8 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs @@ -84,7 +84,8 @@ import qualified Data.Set as Set import qualified Text.PrettyPrint as Disp import Control.Concurrent.STM (TVar, newTVarIO) -import Control.Exception (assert, handle) +import Control.Exception (assert, handle, try) +import Data.Either (isLeft) import qualified Distribution.Client.IndexUtils as IndexUtils import Distribution.Simple.PackageIndex (InstalledPackageIndex) import System.Directory (doesDirectoryExist, doesFileExist, renameDirectory) @@ -381,7 +382,7 @@ rebuildTargets -- Concurrency control: create the job controller and concurrency limits -- for downloading, building and installing. - withJobControl (newJobControlFromParStrat verbosity (Just compiler) buildSettingNumJobs Nothing) $ \jobControl -> do + buildOutcomes <- withJobControl (newJobControlFromParStrat verbosity (Just compiler) buildSettingNumJobs Nothing) $ \jobControl -> do -- Before traversing the install plan, preemptively find all packages that -- will need to be downloaded and start downloading them. asyncDownloadPackages @@ -415,6 +416,10 @@ rebuildTargets ipiTVar pkg pkgBuildStatus + + -- Once the units are built, run their benchmarks. + -- See Note [Running benchmarks] + runDeferredBenchmarks keepGoing installPlan buildOutcomes where keepGoing = buildSettingKeepGoing withRepoCtx = @@ -497,6 +502,62 @@ configuring individual packages. invocation. -} +{- Note [Running benchmarks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Benchmarks must not run at the same time as other benchmarks, or while +something else is being built: they would compete for resources, which skews +their results (#7557). + +Yet 'InstallPlan.execute' builds the units of the plan in parallel. A unit is +a single component of a package, or a whole package when it cannot be built +per component (see 'NotPerComponentReason'). So the benchmark suites of a +project, even those of the same package, are usually separate units. If each +unit ran its benchmarks in its bench phase, right after it is built, they +could run at the same time as each other, or while other units are still +being built. (A whole-package unit runs all of its benchmarks with a single +@Setup bench@ invocation, which runs them one at a time.) + +So, the bench phase of a unit (see 'buildAndRegisterUnpackedPackage') does not +run its benchmarks, but returns them as a 'DeferredBenchmark', which is +recorded in the 'BuildResult' of the unit. Once all the units are built, +'rebuildTargets' runs them one at a time, in plan order, with +'runDeferredBenchmarks', and records their failures in the 'BuildOutcomes'. + +Unless we keep going after failures, no benchmark is run if a unit failed to +build, and no more benchmarks are run once one of them failed. +-} + +-- | Run the deferred benchmarks of the units that were built successfully, +-- one at a time, in plan order. See Note [Running benchmarks]. +runDeferredBenchmarks + :: Bool + -- ^ Keep going after failure + -> ElaboratedInstallPlan + -> BuildOutcomes + -> IO BuildOutcomes +runDeferredBenchmarks keepGoing installPlan buildOutcomes + | not keepGoing && any isLeft buildOutcomes = return buildOutcomes + | otherwise = go buildOutcomes (InstallPlan.executionOrder installPlan) + where + -- Run the benchmarks of the given units, in order, and record their + -- failures. Unless we keep going, stop at the first failure. + go :: BuildOutcomes -> [ElaboratedReadyPackage] -> IO BuildOutcomes + go outcomes [] = return outcomes + go outcomes (pkg : pkgs) + | Just (Right result) <- Map.lookup uid outcomes + , Just bench <- buildResultBenchmark result = do + outcome <- try (runDeferredBenchmark bench) + case outcome of + Right () -> go outcomes pkgs + Left failure + | keepGoing -> go outcomes' pkgs + | otherwise -> return outcomes' + where + outcomes' = Map.insert uid (Left failure) outcomes + | otherwise = go outcomes pkgs + where + uid = nodeKey pkg + -- | Create a package DB if it does not currently exist. createPackageDBIfMissing :: Verbosity @@ -538,7 +599,9 @@ rebuildTarget -> BuildTimeSettings -> AsyncFetchMap -> Lock + -- ^ Serialises package registration -> Lock + -- ^ Serialises access to the setup executable cache -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> TVar InstalledPackageIndex @@ -572,7 +635,13 @@ rebuildTarget BuildStatusDownload -> void $ waitAsyncPackageDownload verbosity downloadMap pkg _ -> return () - return $ BuildResult DocsNotTried TestsNotTried Nothing + return + BuildResult + { buildResultDocs = DocsNotTried + , buildResultTests = TestsNotTried + , buildResultLogFile = Nothing + , buildResultBenchmark = Nothing + } | otherwise = -- We rely on the 'BuildStatus' to decide which phase to start from: case pkgBuildStatus of diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs index f7ddca60251..27205f9dcad 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs @@ -199,6 +199,7 @@ checkPackageFileMonitorChanged { buildResultDocs = docsResult , buildResultTests = testsResult , buildResultLogFile = Nothing + , buildResultBenchmark = Nothing } where (docsResult, testsResult) = buildResult diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs index 864455cb540..36acf5113f3 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs @@ -15,6 +15,7 @@ module Distribution.Client.ProjectBuilding.Types , BuildOutcomes , BuildOutcome , BuildResult (..) + , DeferredBenchmark (..) , BuildFailure (..) , BuildFailureReason (..) ) where @@ -146,9 +147,23 @@ data BuildResult = BuildResult { buildResultDocs :: DocsResult , buildResultTests :: TestsResult , buildResultLogFile :: Maybe FilePath + , buildResultBenchmark :: Maybe DeferredBenchmark + -- ^ The benchmarks of the unit, if any, to be run once all the units of + -- the plan are built. } deriving (Show) +-- | The benchmarks of a unit, to be run once all the units of the plan are +-- built. See Note [Running benchmarks] in "Distribution.Client.ProjectBuilding". +newtype DeferredBenchmark = DeferredBenchmark + { runDeferredBenchmark :: IO () + -- ^ Run the benchmarks of the unit, as its bench phase would have. + -- Throws a 'BuildFailure' if they fail. + } + +instance Show DeferredBenchmark where + show _ = "" + -- | Information arising from the failure to build a single package. data BuildFailure = BuildFailure { buildFailureLogFile :: Maybe FilePath diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs index 9f6b202830c..1c48169e6bd 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs @@ -170,7 +170,9 @@ buildAndRegisterUnpackedPackage -- name of the semaphore is created freshly each time. -> BuildTimeSettings -> Lock + -- ^ Serialises package registration -> Lock + -- ^ Serialises access to the setup executable cache -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> ElaboratedReadyPackage @@ -182,7 +184,8 @@ buildAndRegisterUnpackedPackage -> Maybe FilePath -- ^ The path to an /initialized/ log file -> (forall r. PackageBuildingPhase r -> IO r) - -> IO () + -> IO (Maybe DeferredBenchmark) + -- ^ The benchmarks of the unit, if any, to run once all the units are built buildAndRegisterUnpackedPackage verbosity distDirLayout@DistDirLayout{distTempDirectory} @@ -285,16 +288,23 @@ buildAndRegisterUnpackedPackage (InLibraryArgs $ InLibraryPostConfigureArgs STestPhase mbLBI) -- Bench phase - whenBench $ - timedDelegate $ - PBBenchPhase $ - annotateFailure mlogFile BenchFailed $ - setup - benchCommand - Cabal.benchmarkCommonFlags - (return . benchFlags) - benchArgs - (InLibraryArgs $ InLibraryPostConfigureArgs SBenchPhase mbLBI) + -- + -- The benchmarks are not run here, but returned, to be run once all the + -- units are built. + -- See Note [Running benchmarks] in "Distribution.Client.ProjectBuilding". + let deferredBenchmark + | null (elabBenchTargets pkg) = Nothing + | otherwise = + Just . DeferredBenchmark $ + timedDelegate $ + PBBenchPhase $ + annotateFailure mlogFile BenchFailed $ + setup + benchCommand + Cabal.benchmarkCommonFlags + (return . benchFlags) + benchArgs + (InLibraryArgs $ InLibraryPostConfigureArgs SBenchPhase mbLBI) -- Repl phase whenRepl $ @@ -308,7 +318,7 @@ buildAndRegisterUnpackedPackage replArgs (InLibraryArgs $ InLibraryPostConfigureArgs SReplPhase mbLBI) - return () + return deferredBenchmark where uid = installedUnitId rpkg @@ -347,10 +357,6 @@ buildAndRegisterUnpackedPackage | null (elabTestTargets pkg) = return () | otherwise = action - whenBench action - | null (elabBenchTargets pkg) = return () - | otherwise = action - whenRepl action | null (elabReplTarget pkg) = return () | otherwise = action @@ -521,7 +527,9 @@ buildInplaceUnpackedPackage -> Maybe SemaphoreIdentifier -> BuildTimeSettings -> Lock + -- ^ Serialises package registration -> Lock + -- ^ Serialises access to the setup executable cache -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> ElaboratedReadyPackage @@ -557,85 +565,87 @@ buildInplaceUnpackedPackage True (distPackageCacheDirectory dparams) - buildAndRegisterUnpackedPackage - verbosity - distDirLayout - maybe_semaphore - buildSettings - registerLock - cacheLock - pkgshared - plan - rpkg - ipiTVar - srcdir - builddir - Nothing -- no log file for inplace builds! - $ \case - PBConfigurePhase{runConfigure} -> - whenReconfigure $ do - mbLBI <- runConfigure - invalidatePackageRegFileMonitor packageFileMonitor - updatePackageConfigFileMonitor packageFileMonitor (getSymbolicPath srcdir) pkg - return mbLBI - PBBuildPhase{runBuild} -> - whenRebuild $ withFileMonitor runBuild - PBReplPhase{runRepl} -> - withFileMonitor runRepl - PBHaddockPhase{runHaddock} -> do - withFileMonitor runHaddock - let haddockTarget = elabHaddockForHackage pkg - when (haddockTarget == Cabal.ForHackage) $ do - let dest = distDirectory name <.> "tar.gz" - name = haddockDirName haddockTarget (elabPkgDescription pkg) - docDir = - distBuildDirectory distDirLayout dparams - "doc" - "html" - Tar.createTarGzFile dest docDir name - notice verbosity $ "Documentation tarball created: " ++ dest - - when (buildSettingHaddockOpen && haddockTarget /= Cabal.ForHackage) $ do - let dest = docDir "index.html" - name = haddockDirName haddockTarget (elabPkgDescription pkg) - docDir = case distHaddockOutputDir of - Nothing -> distBuildDirectory distDirLayout dparams "doc" "html" name - Just dir -> dir - catch - (void $ openBrowser dest) - ( \(_ :: ErrorCall) -> - dieWithException verbosity $ - FindOpenProgramLocationErr $ - "Unsupported OS: " <> show os - ) - PBInstallPhase{runCopy = _runCopy, runRegister} -> do - -- PURPOSELY omitted: no copy! - - whenReRegister $ do - -- Register locally - mipkg <- - if elabRequiresRegistration pkg - then do - ipkg <- - runRegister - (elabRegisterPackageDBStack pkg) - Cabal.defaultRegisterOptions - -- Keep the per-project running InstalledPackageIndex up to date. - -- See (ProjIPI2) from Note [Per-project InstalledPackageIndex] - -- in Distribution.Client.ProjectBuilding. - atomically $ modifyTVar ipiTVar (PackageIndex.insert ipkg) - return (Just ipkg) - else return Nothing - - updatePackageRegFileMonitor packageFileMonitor (getSymbolicPath srcdir) mipkg - PBTestPhase{runTest} -> runTest - PBBenchPhase{runBench} -> runBench + deferredBenchmark <- + buildAndRegisterUnpackedPackage + verbosity + distDirLayout + maybe_semaphore + buildSettings + registerLock + cacheLock + pkgshared + plan + rpkg + ipiTVar + srcdir + builddir + Nothing -- no log file for inplace builds! + $ \case + PBConfigurePhase{runConfigure} -> + whenReconfigure $ do + mbLBI <- runConfigure + invalidatePackageRegFileMonitor packageFileMonitor + updatePackageConfigFileMonitor packageFileMonitor (getSymbolicPath srcdir) pkg + return mbLBI + PBBuildPhase{runBuild} -> + whenRebuild $ withFileMonitor runBuild + PBReplPhase{runRepl} -> + withFileMonitor runRepl + PBHaddockPhase{runHaddock} -> do + withFileMonitor runHaddock + let haddockTarget = elabHaddockForHackage pkg + when (haddockTarget == Cabal.ForHackage) $ do + let dest = distDirectory name <.> "tar.gz" + name = haddockDirName haddockTarget (elabPkgDescription pkg) + docDir = + distBuildDirectory distDirLayout dparams + "doc" + "html" + Tar.createTarGzFile dest docDir name + notice verbosity $ "Documentation tarball created: " ++ dest + + when (buildSettingHaddockOpen && haddockTarget /= Cabal.ForHackage) $ do + let dest = docDir "index.html" + name = haddockDirName haddockTarget (elabPkgDescription pkg) + docDir = case distHaddockOutputDir of + Nothing -> distBuildDirectory distDirLayout dparams "doc" "html" name + Just dir -> dir + catch + (void $ openBrowser dest) + ( \(_ :: ErrorCall) -> + dieWithException verbosity $ + FindOpenProgramLocationErr $ + "Unsupported OS: " <> show os + ) + PBInstallPhase{runCopy = _runCopy, runRegister} -> do + -- PURPOSELY omitted: no copy! + + whenReRegister $ do + -- Register locally + mipkg <- + if elabRequiresRegistration pkg + then do + ipkg <- + runRegister + (elabRegisterPackageDBStack pkg) + Cabal.defaultRegisterOptions + -- Keep the per-project running InstalledPackageIndex up to date. + -- See (ProjIPI2) from Note [Per-project InstalledPackageIndex] + -- in Distribution.Client.ProjectBuilding. + atomically $ modifyTVar ipiTVar (PackageIndex.insert ipkg) + return (Just ipkg) + else return Nothing + + updatePackageRegFileMonitor packageFileMonitor (getSymbolicPath srcdir) mipkg + PBTestPhase{runTest} -> runTest + PBBenchPhase{runBench} -> runBench return BuildResult { buildResultDocs = docsResult , buildResultTests = testsResult , buildResultLogFile = Nothing + , buildResultBenchmark = deferredBenchmark } where docsResult = DocsNotTried @@ -755,7 +765,9 @@ buildAndInstallUnpackedPackage -- name of the semaphore is created freshly each time. -> BuildTimeSettings -> Lock + -- ^ Serialises package registration -> Lock + -- ^ Serialises access to the setup executable cache -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> ElaboratedReadyPackage @@ -797,90 +809,91 @@ buildAndInstallUnpackedPackage initLogFile - buildAndRegisterUnpackedPackage - verbosity - distDirLayout - maybe_semaphore - buildSettings - registerLock - cacheLock - pkgshared - plan - rpkg - ipiTVar - srcdir - builddir - mlogFile - $ \case - PBConfigurePhase{runConfigure} -> do - noticeProgress ProgressStarting - runConfigure - PBBuildPhase{runBuild} -> do - noticeProgress ProgressBuilding - _monitors <- runBuild - return () - PBHaddockPhase{runHaddock} -> do - noticeProgress ProgressHaddock - _monitors <- runHaddock - return () - PBInstallPhase{runCopy, runRegister, getInstalledPackageInfo} -> do - noticeProgress ProgressInstalling - - -- Create an IORef used to retrieve the InstalledPackageInfo computed - -- by running "register". - ipkgRef <- newIORef Nothing - - let registerPkg - | not (elabRequiresRegistration pkg) = - debug verbosity $ - "registerPkg: elab does NOT require registration for " - ++ prettyShow uid - | otherwise = do - assert - ( elabRegisterPackageDBStack pkg - == storePackageDBStack compiler (elabPackageDbs pkg) - ) - (return ()) - ipkg <- - runRegister - (elabRegisterPackageDBStack pkg) - Cabal.defaultRegisterOptions - { Cabal.registerMultiInstance = True - , Cabal.registerSuppressFilesCheck = True - } - -- Write the InstalledPackageInfo to the IORef - writeIORef ipkgRef (Just ipkg) - - -- Actual installation - void $ - newStoreEntry - verbosity - storeDirLayout - compiler - uid - (copyPkgFiles verbosity pkgshared pkg runCopy) - registerPkg - - -- Keep the per-project running InstalledPackageIndex TVar up to date. - -- This must run regardless of whether newStoreEntry won or lost the - -- race (UseNewStoreEntry/UseExistingStoreEntry). - -- - -- See (ProjIPI2) in Note [Per-project InstalledPackageIndex]. - when (elabRequiresRegistration pkg) $ do - -- If we won the race, we use the InstalledPackageInfo that was - -- computed by 'runRegister'. If we lost, then we fall back to - -- 'getInstalledPackageInfo' which re-runs 'Cabal register' - -- (takes ~100ms). - mipkg <- readIORef ipkgRef - ipkg <- maybe getInstalledPackageInfo return mipkg - atomically $ modifyTVar ipiTVar (PackageIndex.insert ipkg) - - -- No tests on install - PBTestPhase{} -> return () - -- No bench on install - PBBenchPhase{} -> return () - -- No repl on install - PBReplPhase{} -> return () + deferredBenchmark <- + buildAndRegisterUnpackedPackage + verbosity + distDirLayout + maybe_semaphore + buildSettings + registerLock + cacheLock + pkgshared + plan + rpkg + ipiTVar + srcdir + builddir + mlogFile + $ \case + PBConfigurePhase{runConfigure} -> do + noticeProgress ProgressStarting + runConfigure + PBBuildPhase{runBuild} -> do + noticeProgress ProgressBuilding + _monitors <- runBuild + return () + PBHaddockPhase{runHaddock} -> do + noticeProgress ProgressHaddock + _monitors <- runHaddock + return () + PBInstallPhase{runCopy, runRegister, getInstalledPackageInfo} -> do + noticeProgress ProgressInstalling + + -- Create an IORef used to retrieve the InstalledPackageInfo computed + -- by running "register". + ipkgRef <- newIORef Nothing + + let registerPkg + | not (elabRequiresRegistration pkg) = + debug verbosity $ + "registerPkg: elab does NOT require registration for " + ++ prettyShow uid + | otherwise = do + assert + ( elabRegisterPackageDBStack pkg + == storePackageDBStack compiler (elabPackageDbs pkg) + ) + (return ()) + ipkg <- + runRegister + (elabRegisterPackageDBStack pkg) + Cabal.defaultRegisterOptions + { Cabal.registerMultiInstance = True + , Cabal.registerSuppressFilesCheck = True + } + -- Write the InstalledPackageInfo to the IORef + writeIORef ipkgRef (Just ipkg) + + -- Actual installation + void $ + newStoreEntry + verbosity + storeDirLayout + compiler + uid + (copyPkgFiles verbosity pkgshared pkg runCopy) + registerPkg + + -- Keep the per-project running InstalledPackageIndex TVar up to date. + -- This must run regardless of whether newStoreEntry won or lost the + -- race (UseNewStoreEntry/UseExistingStoreEntry). + -- + -- See (ProjIPI2) in Note [Per-project InstalledPackageIndex]. + when (elabRequiresRegistration pkg) $ do + -- If we won the race, we use the InstalledPackageInfo that was + -- computed by 'runRegister'. If we lost, then we fall back to + -- 'getInstalledPackageInfo' which re-runs 'Cabal register' + -- (takes ~100ms). + mipkg <- readIORef ipkgRef + ipkg <- maybe getInstalledPackageInfo return mipkg + atomically $ modifyTVar ipiTVar (PackageIndex.insert ipkg) + + -- No tests on install + PBTestPhase{} -> return () + -- No bench on install + PBBenchPhase{} -> return () + -- No repl on install + PBReplPhase{} -> return () -- TODO: [nice to have] we currently rely on Setup.hs copy to do the right -- thing. Although we do copy into an image dir and do the move into the @@ -903,6 +916,7 @@ buildAndInstallUnpackedPackage { buildResultDocs = docsResult , buildResultTests = testsResult , buildResultLogFile = mlogFile + , buildResultBenchmark = deferredBenchmark } where uid = installedUnitId rpkg diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBench/MultipleBenchmarks/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBench/MultipleBenchmarks/cabal.out index cff1673e167..e0c9cea2e80 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBench/MultipleBenchmarks/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBench/MultipleBenchmarks/cabal.out @@ -17,11 +17,11 @@ In order, the following will be built: Configuring benchmark 'bar' for MultipleBenchmarks-1.0... Preprocessing benchmark 'bar' for MultipleBenchmarks-1.0... Building benchmark 'bar' for MultipleBenchmarks-1.0... +Preprocessing benchmark 'foo' for MultipleBenchmarks-1.0... +Building benchmark 'foo' for MultipleBenchmarks-1.0... Running 1 benchmarks... Benchmark bar: RUNNING... Benchmark bar: FINISH -Preprocessing benchmark 'foo' for MultipleBenchmarks-1.0... -Building benchmark 'foo' for MultipleBenchmarks-1.0... Running 1 benchmarks... Benchmark foo: RUNNING... Benchmark foo: FINISH diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/cabal.project b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/cabal.project new file mode 100644 index 00000000000..33f2d949688 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/cabal.project @@ -0,0 +1 @@ +packages: pkg-a pkg-b diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/cabal.test.hs new file mode 100644 index 00000000000..65e453205fb --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/cabal.test.hs @@ -0,0 +1,21 @@ +import Test.Cabal.Prelude + +import Data.List (isInfixOf, isPrefixOf, isSuffixOf) + +-- #7557: benchmarks are only run once everything is built, and one at a time, +-- even when building in parallel. +main = cabalTest $ + -- Parallel flag means output of this test is nondeterministic + recordMode DoNotRecord $ do + -- Each benchmark fails if another one is running at the same time, + -- see Bench.hs. + res <- cabal' "v2-bench" ["-j3", "all"] + let isBuildStep l = + any (`isPrefixOf` l) ["Configuring ", "Preprocessing ", "Building ", "Linking "] + || any (`isInfixOf` l) ["] Compiling ", "] Linking "] + isBenchmarkRun l = "Benchmark " `isPrefixOf` l && ": RUNNING..." `isSuffixOf` l + output = lines (filter (/= '\r') (resultOutput res)) + afterFirstRun = dropWhile (not . isBenchmarkRun) output + assertEqual "Number of benchmarks run" 3 (length (filter isBenchmarkRun output)) + assertBool "Something was built after the first benchmark started" $ + not (any isBuildStep afterFirstRun) diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-a/Bench.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-a/Bench.hs new file mode 100644 index 00000000000..6fbd3e30eb4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-a/Bench.hs @@ -0,0 +1,18 @@ +import Control.Concurrent (threadDelay) +import System.Directory (createDirectory, removeDirectory) +import System.Exit (die) +import System.IO.Error (catchIOError, isAlreadyExistsError) + +-- All the benchmarks of this test, in both packages, claim the same marker +-- directory while they run. Creating it fails if it already exists, that is, +-- if another benchmark is running at the same time. +main :: IO () +main = do + createDirectory marker `catchIOError` \e -> + if isAlreadyExistsError e + then die "Another benchmark is running at the same time" + else ioError e + threadDelay 2000000 + removeDirectory marker + where + marker = "../benchmark-running" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-a/pkg-a.cabal b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-a/pkg-a.cabal new file mode 100644 index 00000000000..098b4a09f33 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-a/pkg-a.cabal @@ -0,0 +1,16 @@ +cabal-version: 3.0 +name: pkg-a +version: 1.0 +build-type: Simple + +benchmark a1 + type: exitcode-stdio-1.0 + main-is: Bench.hs + build-depends: base, directory + default-language: Haskell2010 + +benchmark a2 + type: exitcode-stdio-1.0 + main-is: Bench.hs + build-depends: base, directory + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-b/Bench.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-b/Bench.hs new file mode 100644 index 00000000000..6fbd3e30eb4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-b/Bench.hs @@ -0,0 +1,18 @@ +import Control.Concurrent (threadDelay) +import System.Directory (createDirectory, removeDirectory) +import System.Exit (die) +import System.IO.Error (catchIOError, isAlreadyExistsError) + +-- All the benchmarks of this test, in both packages, claim the same marker +-- directory while they run. Creating it fails if it already exists, that is, +-- if another benchmark is running at the same time. +main :: IO () +main = do + createDirectory marker `catchIOError` \e -> + if isAlreadyExistsError e + then die "Another benchmark is running at the same time" + else ioError e + threadDelay 2000000 + removeDirectory marker + where + marker = "../benchmark-running" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-b/PkgB.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-b/PkgB.hs new file mode 100644 index 00000000000..8dceeaf7f22 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-b/PkgB.hs @@ -0,0 +1,4 @@ +module PkgB (pkgB) where + +pkgB :: String +pkgB = "pkg-b" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-b/pkg-b.cabal b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-b/pkg-b.cabal new file mode 100644 index 00000000000..b3a0d86e7f5 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBench/Sequential/pkg-b/pkg-b.cabal @@ -0,0 +1,17 @@ +cabal-version: 3.0 +name: pkg-b +version: 1.0 +build-type: Simple + +-- The benchmark depends on a library, so that it is still being built when +-- the benchmarks of pkg-a are ready to run. +library + exposed-modules: PkgB + build-depends: base + default-language: Haskell2010 + +benchmark b1 + type: exitcode-stdio-1.0 + main-is: Bench.hs + build-depends: base, directory, pkg-b + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Regression/T5309/cabal.out b/cabal-testsuite/PackageTests/Regression/T5309/cabal.out index e799843e5b6..6a7dfd612d6 100644 --- a/cabal-testsuite/PackageTests/Regression/T5309/cabal.out +++ b/cabal-testsuite/PackageTests/Regression/T5309/cabal.out @@ -43,12 +43,12 @@ In order, the following will be built: Configuring benchmark 'bench-no-lib' for T5309-1.0.0.0... Preprocessing benchmark 'bench-no-lib' for T5309-1.0.0.0... Building benchmark 'bench-no-lib' for T5309-1.0.0.0... -Running 1 benchmarks... -Benchmark bench-no-lib: RUNNING... -Benchmark bench-no-lib: FINISH Configuring benchmark 'bench-with-lib' for T5309-1.0.0.0... Preprocessing benchmark 'bench-with-lib' for T5309-1.0.0.0... Building benchmark 'bench-with-lib' for T5309-1.0.0.0... Running 1 benchmarks... +Benchmark bench-no-lib: RUNNING... +Benchmark bench-no-lib: FINISH +Running 1 benchmarks... Benchmark bench-with-lib: RUNNING... Benchmark bench-with-lib: FINISH diff --git a/changelog.d/issue-7557.md b/changelog.d/issue-7557.md new file mode 100644 index 00000000000..ca5dfd8995e --- /dev/null +++ b/changelog.d/issue-7557.md @@ -0,0 +1,24 @@ +--- +synopsis: "`cabal bench` runs benchmarks one at a time, once everything is built" +packages: [cabal-install] +prs: 12407 +issues: 7557 +significance: significant +--- + +`cabal bench` used to run each benchmark as soon as it was built. When building +in parallel (e.g. with `-j`), several benchmarks could thus run at the same time, +and while other components were still being built, so that they competed for +resources, which skewed their results. + +Now, `cabal bench` first builds everything that is needed (still in parallel), +and only then runs the benchmarks, one at a time, in the order of the build +plan. Consequently: + +- The first benchmark starts only once everything is built, so its results + come later than before, and all the build output now precedes the output of + the benchmarks. +- Without `--keep-going`, no benchmark is run if anything fails to build, and + no further benchmark is run once one of them has failed. With + `--keep-going`, the benchmarks of everything that was built successfully are + run. diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index 0c4fb040375..5854e98de53 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -1337,6 +1337,12 @@ they are up to date. ``cabal bench`` inherits flags of the ``bench`` subcommand of ``Setup.hs``, :ref:`see the corresponding section `. +``cabal bench`` first builds everything that is needed (in parallel, e.g. with +``-j``), and only then runs the benchmarks, one at a time, so that they do not +compete for resources with each other or with the build, which would skew +their results. Without ``--keep-going``, no benchmark is run if the build +fails. + cabal test ^^^^^^^^^^ diff --git a/release-notes/Cabal-3.18.2.0.md b/release-notes/Cabal-3.18.2.0.md index 858e8a6735a..3f79db14357 100644 --- a/release-notes/Cabal-3.18.2.0.md +++ b/release-notes/Cabal-3.18.2.0.md @@ -1,6 +1,19 @@ Cabal and Cabal-syntax 3.18.2.0 changelog and release notes --- +### Notice + +- GHCJS support is deprecated [#11609](https://github.com/haskell/cabal/issues/11609) [#12396](https://github.com/haskell/cabal/pull/12396) + + This is the last release series that knows about the GHCJS compiler. + The next major release removes the `Distribution.Simple.GHCJS` module, + the `--ghcjs` flag, the `ghcjs` and `ghcjs-pkg` programs and the GHCJS + build paths. The `ghcjs-options` family of fields in package + descriptions will still parse but have no effect. + + Use the JavaScript backend of GHC instead, for example + `--with-compiler=javascript-unknown-ghcjs-ghc`. + ### Significant changes - Mark `CabalSpecV3_18` as the latest supported specification [#12271](https://github.com/haskell/cabal/issues/12271) [#12273](https://github.com/haskell/cabal/pull/12273) diff --git a/release-notes/cabal-install-3.18.2.0.md b/release-notes/cabal-install-3.18.2.0.md index 61806a4eba8..2088e57ff4b 100644 --- a/release-notes/cabal-install-3.18.2.0.md +++ b/release-notes/cabal-install-3.18.2.0.md @@ -46,6 +46,17 @@ cabal-install 3.18.2.0 changelog and release notes flags: -pkg-config +bundled-c-zlib ``` +- GHCJS support is deprecated [#11609](https://github.com/haskell/cabal/issues/11609) [#12396](https://github.com/haskell/cabal/pull/12396) + + This is the last release series that knows about the GHCJS compiler. + The next major release removes the `--ghcjs` flag, the `ghcjs` and + `ghcjs-pkg` programs and the GHCJS build paths, and selecting + `compiler: ghcjs` will fail with an error. The `ghcjs-options` family + of fields in package descriptions will still parse but have no effect. + + Use the JavaScript backend of GHC instead, for example + `--with-compiler=javascript-unknown-ghcjs-ghc`. + ### Important changes - Fix `renameFileWithRetry` leaving temporary files after copying [#12244](https://github.com/haskell/cabal/issues/12244) [#12246](https://github.com/haskell/cabal/pull/12246)