Repository : ssh://darcs.haskell.org//srv/darcs/haddock On branch : ghc-7.6
http://hackage.haskell.org/trac/ghc/changeset/13e5da9d435168a81060e6cc6a262a4fe5315934 >--------------------------------------------------------------- commit 13e5da9d435168a81060e6cc6a262a4fe5315934 Author: Simon Hengel <s...@typeful.net> Date: Sun Oct 7 17:57:11 2012 +0200 runtests.hs: Make -Wall proof >--------------------------------------------------------------- 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 9d5d050..2f218d1 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 _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
