diff options
| author | Alec Theriault <alec.theriault@gmail.com> | 2018-08-21 00:42:52 -0700 |
|---|---|---|
| committer | Alexander Biehl <alexbiehl@gmail.com> | 2018-08-21 09:42:52 +0200 |
| commit | d25a4f1ec834fa69663a50a6963476e8b3576d1a (patch) | |
| tree | 58670c643bfdbe2f1525618bcbe52ab28fcb3ddb /haddock-test/src/Test/Haddock/Process.hs | |
| parent | 72d82e52f2a6225686d9668790ac33c1d1743193 (diff) | |
Better test output when Haddock crashes on a test (#902)
In particular: we report the tests that crashed seperately from the tests
that produced incorrect output. In order for tests to pass (and exit 0),
they must not crash and must produce the right output.
Diffstat (limited to 'haddock-test/src/Test/Haddock/Process.hs')
| -rw-r--r-- | haddock-test/src/Test/Haddock/Process.hs | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/haddock-test/src/Test/Haddock/Process.hs b/haddock-test/src/Test/Haddock/Process.hs index 52bf9533..a6cab9ac 100644 --- a/haddock-test/src/Test/Haddock/Process.hs +++ b/haddock-test/src/Test/Haddock/Process.hs @@ -40,10 +40,10 @@ runProcess' :: FilePath -> ProcessConfig -> IO ProcessHandle runProcess' path (ProcessConfig { .. }) = runProcess path pcArgs pcWorkDir pcEnv pcStdIn pcStdOut pcStdErr - -waitForSuccess :: String -> ProcessHandle -> IO () -waitForSuccess msg handle = do - result <- waitForProcess handle - unless (result == ExitSuccess) $ do - hPutStrLn stderr $ msg - exitFailure +-- | Wait for a process to finish running. If it ends up failing, print out the +-- error message. +waitForSuccess :: String -> Handle -> ProcessHandle -> IO Bool +waitForSuccess msg out handle = do + succeeded <- fmap (== ExitSuccess) $ waitForProcess handle + unless succeeded $ hPutStrLn out msg + pure succeeded |