clean up concurrent output of tests

Using concurrent-output this is easy. Just have to check if tasty has
color enabled, and propagate it into the worker processes, some of which
will be run without a controlling console.

Also added a call to installSignalHandlers; I noticed that interrupting
the test suite could leave the console in a bad state and this fixes
that.

The ansi-terminal dependency is free, since tasty also depends on it.

Sponsored-by: Dartmouth College's Datalad project

diff --git a/Test/Framework.hs b/Test/Framework.hs
index 30c15537ec7b1125e7534bfe464a1e195e5f1daf..7f16f1833cf7d3fa056ae59c63962455635491da 100644 (file)
--- a/Test/Framework.hs
+++ b/Test/Framework.hs
@@ -15,10 +15,13 @@ import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck
 import Test.Tasty.Options
 import Test.Tasty.Ingredients.Rerun
+import Test.Tasty.Ingredients.ConsoleReporter
 import Options.Applicative.Types
 import Control.Concurrent
 import Control.Concurrent.Async
 import System.Environment (getArgs)
+import System.Console.Concurrent
+import System.Console.ANSI
 
 import Common
 import Types.Test
@@ -495,7 +498,7 @@ setTestMode testmode = do
                , ("GIT_ANNEX_USE_GIT_SSH", "1")
                , ("TESTMODE", show testmode)
                ]
-
+                               
 runFakeSsh :: [String] -> IO ()
 runFakeSsh ("-n":ps) = runFakeSsh ps
 runFakeSsh (_host:cmd:[]) =
@@ -698,17 +701,21 @@ parallelTestRunner opts mkts
                        hPutStrLn stderr "warnings from tasty:"
                        mapM_ (hPutStrLn stderr) warnings
                environ <- Utility.Env.getEnvironment
-               ps <- getArgs
+               args <- getArgs
                pp <- Annex.Path.programPath
-               exitcodes <- forConcurrently [1..length ts] $ \n -> do
+               termcolor <- hSupportsANSIColor stdout
+               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 subdir = tmpdir </> show n
                        ensuredir subdir
                        let p = (proc pp ps)
                                { env = Just ((subenv, show (n, crippledfilesystem, adjustedbranchok)):environ)
                                , cwd = Just subdir
                                }
-                       withCreateProcess p $
-                               \_ _ _ pid -> waitForProcess pid
+                       (_, _, _, pid) <- createProcessConcurrent p
+                       waitForProcess pid
                unless (keepFailuresOption opts) finalCleanup
                if all (== ExitSuccess) exitcodes
                        then exitSuccess
@@ -732,6 +739,7 @@ parallelTestRunner opts mkts
                                        ]
                                , ts !! (n - 1)
                                ]
+                       installSignalHandlers
                        case tryIngredients ingredients (tastyOptionSet opts) t of
                                Nothing -> error "No tests found!?"
                                Just act -> ifM act

diff --git a/debian/control b/debian/control
index f999940249169bbb13c60336146eb0be041f2d08..34c0f16e4a8ab990219a0d7a7a92c17e0b7b2686 100644 (file)
--- a/debian/control
+++ b/debian/control
@@ -70,6 +70,7 @@ Build-Depends:
        libghc-tasty-hunit-dev,
        libghc-tasty-quickcheck-dev,
        libghc-tasty-rerun-dev,
+       libghc-ansi-terminal-dev,
        libghc-optparse-applicative-dev (>= 0.11.0),
        libghc-torrent-dev,
        libghc-concurrent-output-dev,

diff --git a/git-annex.cabal b/git-annex.cabal
index 85a85175fa5b8241db31b6beadf23f5798ff1f0f..f18af00ba1024ffc9b6ea0f8261f16293848012c 100644 (file)
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -378,6 +378,7 @@ Executable git-annex
    tasty-hunit,
    tasty-quickcheck,
    tasty-rerun,
+   ansi-terminal >= 0.9,
    aws (>= 0.20),
    DAV (>= 1.0)
   CC-Options: -Wall