aboutsummaryrefslogtreecommitdiff
path: root/tests/runtests.hs
blob: 646930ee90b52ec6505b9fff8f3a83322fde3805 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
import System.Cmd
import System.Environment
import System.FilePath
import System.Exit
import System.Directory
import System.Process
import Data.List
import Control.Monad
import Text.Printf
import Text.Regex
import Distribution.Simple.Utils
import Distribution.Simple.Program
import Distribution.Verbosity
import Data.Maybe


main = do
  test
  putStrLn "All tests passed!"


haddockEq file1 file2 = stripLinks file1 == stripLinks file2

stripLinks f = subRegex (mkRegexWithOpts "<A HREF=[^>]*>" False False) f "<A HREF=\"\">"

programOnPath p = do
  result <- findProgramOnPath p silent
  return (isJust result)


check modules strict = do
  forM_ modules $ \mod -> do
    let outfile = "output" </> (dropExtension mod ++ ".html")
    let reffile = "tests" </> dropExtension mod ++ ".html.ref"
    b <- doesFileExist reffile
    if b
      then do
        copyFile reffile ("output" </> takeFileName reffile)
        out <- readFile outfile
        ref <- readFile reffile
        if not $ haddockEq out ref
          then do
            putStrLn $ "Output for " ++ mod ++ " has changed! Exiting with diff:"
            let ref' = stripLinks ref
                out' = stripLinks out
            let reffile' = "output" </> takeFileName reffile ++ ".nolinks"
                outfile' = "output" </> takeFileName outfile ++ ".nolinks"
            writeFile reffile' ref'
            writeFile outfile' out'
            b <- programOnPath "colordiff"
            if b
              then system $ "colordiff " ++ reffile' ++ " " ++ outfile'
              else system $ "diff " ++ reffile' ++ " " ++ outfile'
            if strict then exitFailure else return ()
          else do
            putStrLn $ "Pass: " ++ mod
      else do
        putStrLn $ "Pass: " ++ mod ++ " (no .ref file)"


test = do
  contents <- getDirectoryContents "tests"
  args <- getArgs
  let mods = filter ((==) ".hs" . takeExtension) contents
  let outdir = "output"
  let mods' = map ("tests" </>) mods
  putStrLn ""
  putStrLn "Haddock version: "
  h1 <- runProcess "../dist/build/haddock/haddock" ["--version"] Nothing (Just [("haddock_datadir", "../.")]) Nothing Nothing Nothing
  waitForProcess h1
  putStrLn ""
  putStrLn "GHC version: "
  h2 <- runProcess "../dist/build/haddock/haddock" ["--ghc-version"] Nothing (Just [("haddock_datadir", "../.")]) Nothing Nothing Nothing
  waitForProcess h2
  putStrLn ""

  libdir <- rawSystemStdout normal "../dist/build/haddock/haddock" ["--print-ghc-libdir"]
  let basepath = init libdir ++ "/../../share/doc/ghc/html/libraries/base/"
  let base = "-i " ++ basepath ++ "," ++ basepath ++ "base.haddock"
  let processpath = init libdir ++ "/../../share/doc/ghc/html/libraries/process/"
  let process = "-i " ++ processpath ++ "," ++ processpath ++ "process.haddock"

  putStrLn "Running tests..."
  handle <- runProcess "../dist/build/haddock/haddock" (["-w", "-o", outdir, "-h", "--optghc=-fglasgow-exts", "--optghc=-w", base, process] ++ mods') Nothing (Just [("haddock_datadir", "../.")]) Nothing Nothing Nothing
  code <- waitForProcess handle
  when (code /= ExitSuccess) $ error "Haddock run failed! Exiting."
  check mods (if not (null args) && args !! 0 == "all" then False else True)