From aee6d6b5b733aa9bcfa278f8ed8e7c93472c4671 Mon Sep 17 00:00:00 2001
From: David Waern <david.waern@gmail.com>
Date: Sun, 22 May 2011 15:41:52 +0000
Subject: [PATCH] Use cabal's test suite support to run the test suite

This gives up proper dependency tracking of the test script.
---
 haddock.cabal                |  8 ++++++++
 tests/html-tests/README      | 16 ++++++----------
 tests/html-tests/runtests.hs | 30 ++++++++++++++++--------------
 3 files changed, 30 insertions(+), 24 deletions(-)

diff --git a/haddock.cabal b/haddock.cabal
index 2f36187324..60826ea182 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -198,3 +198,11 @@ library
   
   if flag(in-ghc-tree)
     buildable: False
+
+test-suite html-tests
+  type:             exitcode-stdio-1.0
+  default-language: Haskell2010
+  main-is:          runtests.hs
+  hs-source-dirs:   tests/html-tests
+  build-depends:    base, directory, process, filepath, Cabal, regex-compat
+
diff --git a/tests/html-tests/README b/tests/html-tests/README
index fd906b2baa..644d0a71ca 100644
--- a/tests/html-tests/README
+++ b/tests/html-tests/README
@@ -1,4 +1,3 @@
-
 This is a testsuite for Haddock that uses the concept of "golden files". That
 is, it compares output files against a set of reference files.
 
@@ -6,7 +5,7 @@ To add a new test:
 
  1) Create a module in the "tests" directory.
 
- 2) Run runtests.hs. You should now have output/<modulename>.html. The test
+ 2) Run "cabal test". You should now have output/<modulename>.html. The test
     passes since there is no reference file to compare with.
 
  3) To make a reference file from the output file, do
@@ -14,15 +13,12 @@ To add a new test:
 
 Tips and tricks:
 
-You can
+To copy all output files into reference files, run
   runhaskell copy.hs
 
-to copy all output files into reference files.
-
-You can
-  runhaskell runtests.hs all
-
-to continue despite a failing test.
+You can run all tests despite failing tests, like so
+  cabal test --test-option=all
 
 You can pass extra options to haddock like so
-  runhaskell runtests.hs --title="All Tests" all
+  cabal test --test-options='all --title="All Tests"'
+
diff --git a/tests/html-tests/runtests.hs b/tests/html-tests/runtests.hs
index d2486fde2a..2f7ed2e24d 100644
--- a/tests/html-tests/runtests.hs
+++ b/tests/html-tests/runtests.hs
@@ -14,8 +14,11 @@ import Distribution.Verbosity
 import Data.Maybe
 
 
-haddockBase = ".." </> ".."
-haddockPath = haddockBase </> "dist" </> "build" </> "haddock" </> "haddock"
+packageRoot   = "."
+haddockPath   = packageRoot </> "dist" </> "build" </> "haddock" </> "haddock"
+testSuiteRoot = packageRoot </> "tests" </> "html-tests"
+testDir       = testSuiteRoot </> "tests"
+outDir        = testSuiteRoot </> "output"
 
 
 main = do
@@ -27,7 +30,7 @@ test = do
   x <- doesFileExist haddockPath
   when (not x) $ die "you need to run 'cabal build' successfully first"
 
-  contents <- getDirectoryContents "tests"
+  contents <- getDirectoryContents testDir
   args <- getArgs
   let (opts, spec) = span ("-" `isPrefixOf`) args
   let mods =
@@ -35,17 +38,16 @@ test = do
           x:_ | x /= "all" -> [x ++ ".hs"]
           _ -> filter ((==) ".hs" . takeExtension) contents
 
-  let outdir = "output"
-  let mods' = map ("tests" </>) mods
+  let mods' = map (testDir </>) mods
   putStrLn ""
   putStrLn "Haddock version: "
   h1 <- runProcess haddockPath ["--version"] Nothing
-                   (Just [("haddock_datadir", haddockBase)]) Nothing Nothing Nothing
+                   (Just [("haddock_datadir", packageRoot)]) Nothing Nothing Nothing
   waitForProcess h1
   putStrLn ""
   putStrLn "GHC version: "
   h2 <- runProcess haddockPath ["--ghc-version"] Nothing
-                   (Just [("haddock_datadir", haddockBase)]) Nothing Nothing Nothing
+                   (Just [("haddock_datadir", packageRoot)]) Nothing Nothing Nothing
   waitForProcess h2
   putStrLn ""
 
@@ -63,9 +65,9 @@ test = do
 
   putStrLn "Running tests..."
   handle <- runProcess haddockPath
-                       (["-w", "-o", outdir, "-h", "--pretty-html", "--optghc=-fglasgow-exts"
+                       (["-w", "-o", outDir, "-h", "--pretty-html", "--optghc=-fglasgow-exts"
                         , "--optghc=-w", base, process, ghcprim] ++ opts ++ mods')
-                       Nothing (Just [("haddock_datadir", haddockBase)]) Nothing
+                       Nothing (Just [("haddock_datadir", packageRoot)]) Nothing
                        Nothing Nothing
 
   code <- waitForProcess handle
@@ -75,12 +77,12 @@ test = do
 
 check modules strict = do
   forM_ modules $ \mod -> do
-    let outfile = "output" </> (dropExtension mod ++ ".html")
-    let reffile = "tests" </> dropExtension mod ++ ".html.ref"
+    let outfile = outDir  </> dropExtension mod ++ ".html"
+    let reffile = testDir </> dropExtension mod ++ ".html.ref"
     b <- doesFileExist reffile
     if b
       then do
-        copyFile reffile ("output" </> takeFileName reffile)
+        copyFile reffile (outDir </> takeFileName reffile)
         out <- readFile outfile
         ref <- readFile reffile
         if not $ haddockEq out ref
@@ -88,8 +90,8 @@ check modules strict = 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"
+            let reffile' = outDir </> takeFileName reffile ++ ".nolinks"
+                outfile' = outDir </> takeFileName outfile ++ ".nolinks"
             writeFile reffile' ref'
             writeFile outfile' out'
             b <- programOnPath "colordiff"
-- 
GitLab