diff options
| -rw-r--r-- | tests/html-tests/runtests.hs | 23 |
1 files changed, 17 insertions, 6 deletions
diff --git a/tests/html-tests/runtests.hs b/tests/html-tests/runtests.hs index 9d5d0502..2f218d17 100644 --- a/tests/html-tests/runtests.hs +++ b/tests/html-tests/runtests.hs @@ -10,12 +10,13 @@ import Distribution.Simple.PackageIndex import Distribution.Simple.Program import Distribution.Simple.Utils import Distribution.Verbosity +import System.IO import System.Cmd import System.Directory import System.Environment import System.Exit import System.FilePath -import System.Process (runProcess, waitForProcess) +import System.Process (ProcessHandle, runProcess, waitForProcess) packageRoot, haddockPath, testSuiteRoot, testDir, outDir :: FilePath @@ -54,12 +55,12 @@ test = do putStrLn "Haddock version: " h1 <- runProcess haddockPath ["--version"] Nothing env Nothing Nothing Nothing - waitForProcess h1 + wait h1 "*** Running `haddock --version' failed!" putStrLn "" putStrLn "GHC version: " h2 <- runProcess haddockPath ["--ghc-version"] Nothing env Nothing Nothing Nothing - waitForProcess h2 + wait h2 "*** Running `haddock --ghc-version' failed!" putStrLn "" -- TODO: maybe do something more clever here using haddock.cabal @@ -86,12 +87,19 @@ test = do Nothing env Nothing Nothing Nothing - code <- waitForProcess handle - when (code /= ExitSuccess) $ error "Haddock run failed! Exiting." + wait handle "*** Haddock run failed! Exiting." check mods (if not (null args) && args !! 0 == "all" then False else True) where + + safeHead :: [a] -> Maybe a safeHead xs = case xs of x : _ -> Just x; [] -> Nothing + wait :: ProcessHandle -> String -> IO () + wait h msg = do + r <- waitForProcess h + unless (r == ExitSuccess) $ do + hPutStrLn stderr msg + exitFailure check :: [FilePath] -> Bool -> IO () check modules strict = do @@ -114,10 +122,13 @@ check modules strict = do writeFile reffile' ref' writeFile outfile' out' r <- programOnPath "colordiff" - if r + code <- if r then system $ "colordiff " ++ reffile' ++ " " ++ outfile' else system $ "diff " ++ reffile' ++ " " ++ outfile' if strict then exitFailure else return () + unless (code == ExitSuccess) $ do + hPutStrLn stderr "*** Running diff failed!" + exitFailure else do putStrLn $ "Pass: " ++ mod else do |