add test summary with number of parts and time

Sponsored-by: Brock Spratlen on Patreon
This commit is contained in:
Joey Hess 2023-05-18 11:19:59 -04:00
parent 287b070597
commit 28c4051e3d
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 14 additions and 3 deletions

View file

@ -128,7 +128,7 @@ runner :: TestOptions -> IO ()
runner opts = parallelTestRunner opts tests
tests :: Int -> Bool -> Bool -> TestOptions -> [TestTree]
tests n crippledfilesystem adjustedbranchok opts =
tests numparts crippledfilesystem adjustedbranchok opts =
properties
: withTestMode remotetestmode testRemotes
: concatMap mkrepotests testmodes
@ -147,7 +147,7 @@ tests n crippledfilesystem adjustedbranchok opts =
| otherwise = Nothing
mkrepotests (d, te) = map
(\uts -> withTestMode te uts)
(repoTests d n)
(repoTests d numparts)
properties :: TestTree
properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $

View file

@ -23,6 +23,7 @@ import Control.Concurrent.STM
import System.Environment (getArgs)
import System.Console.Concurrent
import System.Console.ANSI
import Data.Time.Clock
import GHC.Conc
import System.IO.Unsafe (unsafePerformIO)
import System.PosixCompat.Files (isSymbolicLink, isRegularFile, fileMode, unionFileModes, ownerWriteMode)
@ -63,6 +64,7 @@ import qualified Utility.Exception
import qualified Utility.ThreadScheduler
import qualified Utility.Tmp.Dir
import qualified Utility.Metered
import qualified Utility.HumanTime
import qualified Command.Uninit
-- Run a process. The output and stderr is captured, and is only
@ -799,11 +801,20 @@ parallelTestRunner' numjobs opts mkts
(_, _, _, pid) <- createProcessConcurrent p
waitForProcess pid
nvar <- newTVarIO (1, length ts)
starttime <- getCurrentTime
exitcodes <- forConcurrently [1..numjobs] $ \_ ->
worker [] nvar runone
unless (keepFailuresOption opts) finalCleanup
duration <- Utility.HumanTime.durationSince starttime
case nub (filter (/= ExitSuccess) (concat exitcodes)) of
[] -> exitSuccess
[] -> do
putStrLn ""
putStrLn $ "All tests succeeded. (Ran "
++ show (length ts)
++ " test groups in "
++ Utility.HumanTime.fromDuration duration
++ ")"
exitSuccess
[ExitFailure 1] -> 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.)"