Skip to content
Snippets Groups Projects
Commit d25a4f1e authored by Alec Theriault's avatar Alec Theriault Committed by Alex Biehl
Browse files

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.
parent 72d82e52
No related branches found
No related tags found
No related merge requests found
......@@ -34,12 +34,12 @@ data CheckResult
runAndCheck :: Config c -> IO ()
runAndCheck cfg = do
runHaddock cfg
checkFiles cfg
crashed <- runHaddock cfg
checkFiles cfg crashed
checkFiles :: Config c -> IO ()
checkFiles cfg@(Config { .. }) = do
checkFiles :: Config c -> Bool -> IO ()
checkFiles cfg@(Config { .. }) somethingCrashed = do
putStrLn "Testing output files..."
files <- ignore <$> getDirectoryTree (cfgOutDir cfg)
......@@ -54,13 +54,14 @@ checkFiles cfg@(Config { .. }) = do
Error msg -> putStrLn ("ERROR (" ++ msg ++ ")") >> return Nothing
Accepted -> putStrLn "ACCEPTED" >> return Nothing
if null failed
then do
putStrLn "All tests passed!"
exitSuccess
else do
maybeDiff cfg failed
exitFailure
if (null failed && not somethingCrashed)
then do
putStrLn "All tests passed!"
exitSuccess
else do
unless (null failed) $ maybeDiff cfg failed
when somethingCrashed $ putStrLn "Some tests crashed."
exitFailure
where
ignore = filter (not . dcfgCheckIgnore cfgDirConfig)
......@@ -72,12 +73,14 @@ maybeDiff cfg@(Config { cfgDiffTool = (Just diff) }) files = do
forM_ files $ diffFile cfg diff
runHaddock :: Config c -> IO ()
-- | Runs Haddock on all of the test packages, and returns whether 'True' if
-- any of them caused Haddock to crash.
runHaddock :: Config c -> IO Bool
runHaddock cfg@(Config { .. }) = do
createEmptyDirectory $ cfgOutDir cfg
putStrLn "Generating documentation..."
forM_ cfgPackages $ \tpkg -> do
successes <- forM cfgPackages $ \tpkg -> do
haddockStdOut <- openFile cfgHaddockStdOut WriteMode
let pc = processConfig
{ pcArgs = concat
......@@ -87,9 +90,20 @@ runHaddock cfg@(Config { .. }) = do
]
, pcEnv = Just $ cfgEnv
, pcStdOut = Just $ haddockStdOut
, pcStdErr = Just $ haddockStdOut
}
handle <- runProcess' cfgHaddockPath pc
waitForSuccess "Failed to run Haddock on specified test files" handle
let msg = "Failed to run Haddock on test package '" ++ tpkgName tpkg ++ "'"
succeeded <- waitForSuccess msg stdout =<< runProcess' cfgHaddockPath pc
unless succeeded $ removeDirectoryRecursive (outDir cfgDirConfig tpkg)
pure succeeded
let somethingFailed = any not successes
when somethingFailed $
putStrLn ("Haddock output is at '" ++ cfgHaddockStdOut ++ "'. " ++
"This file can be set with `--haddock-stdout`.")
pure somethingFailed
checkFile :: Config c -> FilePath -> IO CheckResult
......
......@@ -224,13 +224,13 @@ printVersions env haddockPath = do
{ pcEnv = Just env
, pcArgs = ["--version"]
}
waitForSuccess "Failed to run `haddock --version`" handleHaddock
void $ waitForSuccess "Failed to run `haddock --version`" stderr handleHaddock
handleGhc <- runProcess' haddockPath $ processConfig
{ pcEnv = Just env
, pcArgs = ["--ghc-version"]
}
waitForSuccess "Failed to run `haddock --ghc-version`" handleGhc
void $ waitForSuccess "Failed to run `haddock --ghc-version`" stderr handleGhc
baseDependencies :: FilePath -> IO [String]
......
......@@ -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
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment