test: Added --jobs option

Default to the number of CPU cores, which seems about optimal
on my laptop. Using one more saves me 2 seconds actually.

Better packing of workers improves speed significantly.

In 2 tests runs, I saw segfaulting workers despite my attempt
to work around that issue. So detect when a worker does, and re-run it.

Removed installSignalHandlers again, because I was seeing an
error "lost signal due to full pipe", which I guess was somehow caused
by using it.

Sponsored-by: Dartmouth College's Datalad project
This commit is contained in:
Joey Hess 2022-03-16 14:42:07 -04:00
parent be31a8a3d2
commit 025c18128b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
6 changed files with 77 additions and 24 deletions

View file

@ -19,12 +19,15 @@ import Test.Tasty.Ingredients.ConsoleReporter
import Options.Applicative.Types
import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.STM
import System.Environment (getArgs)
import System.Console.Concurrent
import System.Console.ANSI
import GHC.Conc
import Common
import Types.Test
import Types.Concurrency
import qualified Annex
import qualified Annex.UUID
@ -676,13 +679,35 @@ make_writeable d = void $
- prevents some failures to clean up after the test suite.
-}
parallelTestRunner :: TestOptions -> (Int -> Bool -> Bool -> TestOptions -> [TestTree]) -> IO ()
parallelTestRunner opts mkts
parallelTestRunner opts mkts = do
numjobs <- case concurrentJobs opts of
Just NonConcurrent -> pure 1
Just (Concurrent n) -> pure n
Just ConcurrentPerCpu -> getNumProcessors
Nothing -> getNumProcessors
parallelTestRunner' numjobs opts mkts
parallelTestRunner' :: Int -> TestOptions -> (Int -> Bool -> Bool -> TestOptions -> [TestTree]) -> IO ()
parallelTestRunner' numjobs opts mkts
| fakeSsh opts = runFakeSsh (internalData opts)
| otherwise = go =<< Utility.Env.getEnv subenv
where
numparts = 1
subenv = "GIT_ANNEX_TEST_SUBPROCESS"
go Nothing = do
-- Make more parts than there are jobs, because some parts
-- are larger, and this allows the smaller parts to be packed
-- in more efficiently, speeding up the test suite overall.
numparts = numjobs * 2
worker rs nvar a = do
(n, m) <- atomically $ do
(n, m) <- readTVar nvar
writeTVar nvar (n+1, m)
return (n, m)
if n > m
then return rs
else do
r <- a n
worker (r:rs) nvar a
go Nothing = withConcurrentOutput $ do
ensuredir tmpdir
crippledfilesystem <- fst <$> Annex.Init.probeCrippledFileSystem'
(toRawFilePath tmpdir)
@ -700,7 +725,7 @@ parallelTestRunner opts mkts
let ps = if useColor (lookupOption (tastyOptionSet opts)) termcolor
then "--color=always":args
else "--color=never":args
exitcodes <- withConcurrentOutput $ forConcurrently [1..length ts] $ \n -> do
let runone n = do
let subdir = tmpdir </> show n
ensuredir subdir
let p = (proc pp ps)
@ -708,11 +733,21 @@ parallelTestRunner opts mkts
, cwd = Just subdir
}
(_, _, _, pid) <- createProcessConcurrent p
waitForProcess pid
ret <- waitForProcess pid
-- Work around this strange issue
-- https://github.com/UnkindPartition/tasty/issues/326
-- when other workaround does not work.
if ret == ExitFailure (-11)
then runone n
else return ret
nvar <- newTVarIO (1, length ts)
exitcodes <- forConcurrently [1..numjobs] $ \_ ->
worker [] nvar runone
let exitcodes' = concat exitcodes
unless (keepFailuresOption opts) finalCleanup
if all (== ExitSuccess) exitcodes
if all (== ExitSuccess) exitcodes'
then exitSuccess
else case (filter (/= ExitFailure 1) exitcodes) of
else case (filter (/= ExitFailure 1) exitcodes') of
[] -> do
putStrLn " (Failures above could be due to a bug in git-annex, or an incompatibility"
putStrLn " with utilities, such as git, installed on this system.)"
@ -732,7 +767,6 @@ parallelTestRunner opts mkts
]
, ts !! (n - 1)
]
installSignalHandlers
case tryIngredients ingredients (tastyOptionSet opts) t of
Nothing -> error "No tests found!?"
Just act -> ifM act