cabal-show-detail-direct

commit 3792d212a6f60573ef43dd72088a353725d09461
Author: Joachim Breitner <mail@joachim-breitner.de>
Date:   Thu Nov 5 11:31:12 2015 +0100

    test: New mode --show-details=direct

    This mode implements #2911, and allows to connect the test runner
    directly to stdout/stdin. This is more reliable in the presence of no
    threading, i.e. a work-arond for #2398.

    I make the test suite use this, so that it passes again, despite
    printing lots of stuff. Once #2398 is fixed properly, the test suite
    should probably be extended to test all the various --show-details
    modes.

Gbp-Pq: Name cabal-show-detail-direct.patch

diff --git a/libraries/Cabal/Cabal/Distribution/Simple/Setup.hs b/libraries/Cabal/Cabal/Distribution/Simple/Setup.hs
index b87b5678fc964d54f258b519d3bc95bed14c3d23..096491a83864d7cd895b560af92eebb2c4cd415a 100644 (file)
--- a/libraries/Cabal/Cabal/Distribution/Simple/Setup.hs
+++ b/libraries/Cabal/Cabal/Distribution/Simple/Setup.hs
@@ -1725,7 +1725,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]
@@ -1813,7 +1813,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/libraries/Cabal/Cabal/Distribution/Simple/Test/ExeV10.hs b/libraries/Cabal/Cabal/Distribution/Simple/Test/ExeV10.hs
index 6dc622ede668a10710c70764ecf975853e92bdd4..b634ba346604470607880e60254ef9f36f0234c0 100644 (file)
--- a/libraries/Cabal/Cabal/Distribution/Simple/Test/ExeV10.hs
+++ b/libraries/Cabal/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