aboutsummaryrefslogtreecommitdiff
path: root/tests/golden-tests/runtests.hs
blob: 7d5ec86574887d6c5d896b7894b1f5d9bee74e93 (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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
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


haddockBase = ".." </> ".."
haddockPath = haddockBase </> "dist" </> "build" </> "haddock" </> "haddock"


main = do
  test
  putStrLn "All tests passed!"


test = do
  x <- doesFileExist haddockPath
  when (not x) $ die "you need to run 'cabal build' successfully first"

  contents <- getDirectoryContents "tests"
  args <- getArgs
  let (opts, spec) = span ("-" `isPrefixOf`) args
  let mods =
        case spec of
          x:_ | x /= "all" -> [x ++ ".hs"]
          _ -> filter ((==) ".hs" . takeExtension) contents

  let outdir = "output"
  let mods' = map ("tests" </>) mods
  putStrLn ""
  putStrLn "Haddock version: "
  h1 <- runProcess haddockPath ["--version"] Nothing
                   (Just [("haddock_datadir", haddockBase)]) Nothing Nothing Nothing
  waitForProcess h1
  putStrLn ""
  putStrLn "GHC version: "
  h2 <- runProcess haddockPath ["--ghc-version"] Nothing
                   (Just [("haddock_datadir", haddockBase)]) Nothing Nothing Nothing
  waitForProcess h2
  putStrLn ""

  -- TODO: use Distribution.* to get the packages instead
  libdir <- rawSystemStdout normal haddockPath ["--print-ghc-libdir"]
  let librariesPath = ".."</>".."</>"share"</>"doc"</>"ghc"</>"html"</>"libraries"

  let mkDep name version =
        let path = init libdir </> librariesPath </> name ++ "-" ++ version
        in  "-i " ++ path ++ "," ++ path </> name ++ ".haddock"

  let base    = mkDep "base" "4.2.0.2"
      process = mkDep "process" "1.0.1.3"
      ghcprim = mkDep "ghc-prim" "0.2.0.0"

  putStrLn "Running tests..."
  handle <- runProcess haddockPath
                       (["-w", "-o", outdir, "-h", "--optghc=-fglasgow-exts"
                        , "--optghc=-w", base, process, ghcprim] ++ opts ++ mods')
                       Nothing (Just [("haddock_datadir", haddockBase)]) 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)


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)"


haddockEq file1 file2 = stripLinks file1 == stripLinks file2


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


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