Commit 08f497a0 authored by Ben Gamari's avatar Ben Gamari 🐢

build-all: Fixes from #15304

parent 02e17e3e
......@@ -21,11 +21,28 @@ import Control.Concurrent.STM
import Control.Concurrent.STM.TSem
import Control.Concurrent.Async
cores = 6
-- | How many cores to use in total
cores :: Int
cores = 40
-- | How many cores to use per build
coresPerBuild :: Int
coresPerBuild = 4
-- | How many times to run each nofib benchmark
nofibRepeats :: Int
nofibRepeats = 2
-- | Path to the ghc-utils tree (used to locate @ghc_perf.py@).
ghcUtilsPath :: FilePath
ghcUtilsPath = "/home/ben/ghc/ghc-utils"
-- | Which perf events to collect, if any.
perfEvents :: [String]
perfEvents = []
ghcUtilsPath = ""
-- | Hackage dependencies necessary to build nofib benchmarks.
nofibDeps :: [String]
nofibDeps = [ "random", "old-time", "parallel"]
data Commit = Commit { commitName :: String
......@@ -34,13 +51,19 @@ data Commit = Commit { commitName :: String
deriving (Eq, Ord, Show)
commitWorkDir :: Commit -> FilePath
commitWorkDir c = "ghc-" <> commitName c
commitWorkDir c = "ghc-" <> sanitize (commitName c)
where
sanitize = map f
where
f '/' = '-'
f c = c
commitResultDir :: Commit -> FilePath
commitResultDir c = "results" </> commitName c
withCommitResultFile :: Commit -> FilePath -> (Handle -> IO a) -> IO a
withCommitResultFile c fname action = do
createDirectoryIfMissing True dir
withFile (dir </> fname) WriteMode action
where
......@@ -100,9 +123,9 @@ checkout = parallel 1 $ task "checkout" $ \commit -> do
]
runProcess_
$ setWorkingDir "ghc"
$ proc "git" ["worktree", "add", "../"<>wdir, commitRef commit]
$ proc "git" ["worktree", "add", "-f" , "../"<>wdir, commitRef commit]
git ["checkout", commitRef commit]
git ["checkout", "--detach", commitRef commit]
git ["--no-pager", "show"]
git ["submodule", "update", "--init"]
......@@ -114,24 +137,25 @@ checkout = parallel 1 $ task "checkout" $ \commit -> do
runInCommitDir commit $ proc "./configure" []
build :: Task
build = parallel cores $ requires [checkout] $ task "build" run
build = parallel coresPerBuild $ requires [checkout] $ task "build" run
where
run commit = withCommitResultFile commit "build.log" $ \hdl -> do
runInCommitDir commit
$ setStderr (useHandleOpen hdl)
$ setStdout (useHandleOpen hdl)
$ proc ("hadrian" </> "build.cabal.sh") ["-j" <> show cores]
$ proc ("hadrian" </> "build-cabal") ["-j" <> show coresPerBuild]
test :: Task
test = parallel cores $ requires [build] $ task "test" run
test = parallel coresPerBuild $ requires [build] $ task "test" run
where
run commit = withCommitResultFile commit "test.log" $ \hdl -> do
resultDir <- canonicalizePath $ commitResultDir commit
runInCommitDir commit
$ setStderr (useHandleOpen hdl)
$ setStdout (useHandleOpen hdl)
$ proc ("hadrian" </> "build.cabal.sh")
$ [ "-j" <> show cores
, "--summary-metrics=" <> commitResultDir commit </> "test-metrics"
$ proc ("hadrian" </> "build-cabal")
$ [ "-j" <> show coresPerBuild
, "--summary-metrics=" <> resultDir </> "test-metrics"
, "test"
]
......@@ -207,6 +231,7 @@ readIfExists fname = do
True -> Just <$> readFile fname
False -> return Nothing
-- | A semaphore that also supports exclusive access.
data ExclSem = ExclSem Int TSem
newExclSem :: Int -> IO ExclSem
......@@ -221,7 +246,7 @@ withExclusive (ExclSem n sem) = bracket_ take release
withNonexclusive :: ExclSem -> Int -> IO a -> IO a
withNonexclusive (ExclSem n sem) m action
| n < m = fail "uh oh"
| n < m = fail $ "withNonexclusive: n="<>show n<>", m="<>show m
| otherwise = bracket_ take release action
where
take = atomically $ replicateM m $ waitTSem sem
......@@ -250,8 +275,8 @@ runTask sem commit task = withSem $ do
assertStamp task' = do
exists <- checkStamp task' commit
unless exists $ fail
$ commitName commit <> ": "
<> taskName task <> " needs " <> taskName task'
$ commitName commit <> ": task `"
<> taskName task <> "` needs prerequisitie task `" <> taskName task' <> "`."
withSem = case taskParallelism task of
Exclusive -> withExclusive sem
......@@ -273,6 +298,7 @@ main = do
exists <- doesDirectoryExist "ghc"
unless exists $ fail "ghc/ should be a GHC checkout"
commits <- readCommits
let tasks = [test]
runTasks 17 commits tasks
print commits
let tasks = [checkout,build,test]
runTasks cores commits tasks
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