diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 6daa67c9fe921dd1a3626adcc06053a8feda8ac4..148c1ced78231bae14ef45b74d4d2f79a348095f 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -1774,7 +1774,7 @@ replCommand progConf = CommandUI -- * Test flags -- ------------------------------------------------------------ -data TestShowDetails = Never | Failures | Always | Streaming +data TestShowDetails = Never | Failures | Always | Streaming | Direct deriving (Eq, Ord, Enum, Bounded, Show) knownTestShowDetails :: [TestShowDetails] @@ -1862,7 +1862,8 @@ testCommand = CommandUI ("'always': always show results of individual test cases. " ++ "'never': never show results of individual test cases. " ++ "'failures': show results of failing test cases. " - ++ "'streaming': show results of test cases in real time.") + ++ "'streaming': show results of test cases in real time." + ++ "'direct': send results of test cases in real time; no log file.") testShowDetails (\v flags -> flags { testShowDetails = v }) (reqArg "FILTER" (readP_to_E (\_ -> "--show-details flag expects one of " diff --git a/Cabal/Distribution/Simple/Test/ExeV10.hs b/Cabal/Distribution/Simple/Test/ExeV10.hs index 18c0b2a80652cacf1422dd2174d4bed2bc4e6997..236ae36e64c927426f40e054d4ba149aa7548cd8 100644 --- a/Cabal/Distribution/Simple/Test/ExeV10.hs +++ b/Cabal/Distribution/Simple/Test/ExeV10.hs @@ -30,7 +30,7 @@ import System.Directory , getCurrentDirectory, removeDirectoryRecursive ) import System.Exit ( ExitCode(..) ) import System.FilePath ( (</>), (<.>) ) -import System.IO ( hGetContents, hPutStr, stdout ) +import System.IO ( hGetContents, hPutStr, stdout, stderr ) runTest :: PD.PackageDescription -> LBI.LocalBuildInfo @@ -63,15 +63,20 @@ runTest pkg_descr lbi flags suite = do -- Write summary notices indicating start of test suite notice verbosity $ summarizeSuiteStart $ PD.testName suite - (rOut, wOut) <- createPipe + (wOut, wErr, logText) <- case details of + Direct -> return (stdout, stderr, "") + _ -> do + (rOut, wOut) <- createPipe - -- Read test executable's output lazily (returns immediately) - logText <- hGetContents rOut - -- Force the IO manager to drain the test output pipe - void $ forkIO $ length logText `seq` return () + -- Read test executable's output lazily (returns immediately) + logText <- hGetContents rOut + -- Force the IO manager to drain the test output pipe + void $ forkIO $ length logText `seq` return () - -- '--show-details=streaming': print the log output in another thread - when (details == Streaming) $ void $ forkIO $ hPutStr stdout logText + -- '--show-details=streaming': print the log output in another thread + when (details == Streaming) $ void $ forkIO $ hPutStr stdout logText + + return (wOut, wOut, logText) -- Run the test executable let opts = map (testOption pkg_descr lbi suite) @@ -93,7 +98,7 @@ runTest pkg_descr lbi flags suite = do exit <- rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv') -- these handles are automatically closed - Nothing (Just wOut) (Just wOut) + Nothing (Just wOut) (Just wErr) -- Generate TestSuiteLog from executable exit code and a machine- -- readable test log. @@ -112,12 +117,10 @@ runTest pkg_descr lbi flags suite = do -- Show the contents of the human-readable log file on the terminal -- if there is a failure and/or detailed output is requested let whenPrinting = when $ - (details > Never) - && (not (suitePassed $ testLogs suiteLog) || details == Always) + ( details == Always || + details == Failures && not (suitePassed $ testLogs suiteLog)) -- verbosity overrides show-details && verbosity >= normal - -- if streaming, we already printed the log - && details /= Streaming whenPrinting $ putStr $ unlines $ lines logText -- Write summary notice to terminal indicating end of test suite diff --git a/Cabal/changelog b/Cabal/changelog index 3c371a55c55e0338bc4e916af7c3ae37ab39690e..bbbb4caafcff81d29d7fa4b7ccb771b11a9adec9 100644 --- a/Cabal/changelog +++ b/Cabal/changelog @@ -13,6 +13,10 @@ * Support Haddock response files (#2746). * Fixed a bug in the Text instance for Platform (#2862). * New 'setup haddock' option: '--for-hackage' (#2852). + * New --show-detail=direct; like streaming, but allows the test + program to detect that is connected to a terminal, and works + reliable with a non-threaded runtime (#2911, and serves as a + work-around for #2398) 1.22.0.0 Johan Tibell <johan.tibell@gmail.com> January 2015 * Support GHC 7.10. diff --git a/Cabal/tests/PackageTests/TestSuiteTests/ExeV10/Check.hs b/Cabal/tests/PackageTests/TestSuiteTests/ExeV10/Check.hs index 50581a9a70cb50d8140d3f970fc64672ba911d89..61c16160a4d2eb10b5d13b8c6e170fbc9a6de057 100644 --- a/Cabal/tests/PackageTests/TestSuiteTests/ExeV10/Check.hs +++ b/Cabal/tests/PackageTests/TestSuiteTests/ExeV10/Check.hs @@ -130,7 +130,7 @@ buildAndTest config name envOverrides flags = do } buildResult <- cabal_build config spec assertBuildSucceeded buildResult - testResult <- cabal_test config spec envOverrides [] + testResult <- cabal_test config spec envOverrides ["--show-details=direct"] assertTestSucceeded testResult -- | Checks for a suitable HPC version for testing.