mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

improve check using nub

Browse source 
This is clearer, and looks at the list content only once rather than
twice, but should have no behavior changes.
This commit is contained in:
Joey Hess 2022-04-19 13:16:01 -04:00
parent c69a3bd842
commit 0e3a31fcc4
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 9 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
Test/Framework.hs
View file

@ -263,11 +263,7 @@ isolateGitConfig a = Utility.Tmp.Dir.withTmpDir "testhome" $ \tmphome -> do
a a
removeDirectoryForCleanup :: FilePath -> IO () removeDirectoryForCleanup :: FilePath -> IO ()
#if MIN_VERSION_directory(1,2,7)
removeDirectoryForCleanup = removePathForcibly removeDirectoryForCleanup = removePathForcibly
#else
removeDirectoryForCleanup = removeDirectoryRecursive
#endif
cleanup :: FilePath -> IO () cleanup :: FilePath -> IO ()
cleanup dir = whenM (doesDirectoryExist dir) $ do cleanup dir = whenM (doesDirectoryExist dir) $ do
@ -743,18 +739,16 @@ parallelTestRunner' numjobs opts mkts
nvar <- newTVarIO (1, length ts) nvar <- newTVarIO (1, length ts)
exitcodes <- forConcurrently [1..numjobs] $ \_ -> exitcodes <- forConcurrently [1..numjobs] $ \_ ->
worker [] nvar runone worker [] nvar runone
let exitcodes' = concat exitcodes
unless (keepFailuresOption opts) finalCleanup unless (keepFailuresOption opts) finalCleanup
if all (== ExitSuccess) exitcodes' case nub (concat exitcodes) of
then exitSuccess [ExitSuccess] -> exitSuccess
else case (filter (/= ExitFailure 1) exitcodes') of [ExitFailure 1] -> do
[] -> do putStrLn " (Failures above could be due to a bug in git-annex, or an incompatibility"
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.)"
putStrLn " with utilities, such as git, installed on this system.)" exitFailure
exitFailure v -> do
v -> do putStrLn $ " Test subprocesses exited with unexpected exit codes: " ++ show (concat exitcodes)
putStrLn $ " Test subprocesses exited with unexpected exit codes: " ++ show v exitFailure
exitFailure
go (Just subenvval) = case readish subenvval of go (Just subenvval) = case readish subenvval of
Nothing -> error ("Bad " ++ subenv) Nothing -> error ("Bad " ++ subenv)
Just (n, crippledfilesystem, adjustedbranchok) -> isolateGitConfig $ do Just (n, crippledfilesystem, adjustedbranchok) -> isolateGitConfig $ do