aboutsummaryrefslogtreecommitdiff
path: root/haddock-test
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-test')
-rw-r--r--haddock-test/src/Test/Haddock.hs44
-rw-r--r--haddock-test/src/Test/Haddock/Config.hs5
-rw-r--r--haddock-test/src/Test/Haddock/Process.hs14
3 files changed, 39 insertions, 24 deletions
diff --git a/haddock-test/src/Test/Haddock.hs b/haddock-test/src/Test/Haddock.hs
index 942c0587..25c64cfe 100644
--- a/haddock-test/src/Test/Haddock.hs
+++ b/haddock-test/src/Test/Haddock.hs
@@ -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
diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs
index 51032a3a..6447361f 100644
--- a/haddock-test/src/Test/Haddock/Config.hs
+++ b/haddock-test/src/Test/Haddock/Config.hs
@@ -196,6 +196,7 @@ loadConfig ccfg dcfg flags files = do
cfgHaddockArgs <- liftM concat . sequence $
[ pure ["--no-warnings"]
+ , pure ["--bypass-interface-version-check"]
, pure ["--odir=" ++ dcfgOutDir dcfg]
, pure ["--optghc=-w"]
, pure ["--optghc=-hide-all-packages"]
@@ -223,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]
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