From 1e78c4dd154b41fa0a50042c97f14d918332d47b Mon Sep 17 00:00:00 2001
From: David Waern <david.waern@gmail.com>
Date: Wed, 7 Apr 2010 22:01:13 +0000
Subject: Make runtests.hs slightly more readable

---
 tests/runtests.hs | 84 +++++++++++++++++++++++++++++++------------------------
 1 file changed, 48 insertions(+), 36 deletions(-)

(limited to 'tests')

diff --git a/tests/runtests.hs b/tests/runtests.hs
index 72492307..eed9cec8 100644
--- a/tests/runtests.hs
+++ b/tests/runtests.hs
@@ -14,18 +14,56 @@ import Distribution.Verbosity
 import Data.Maybe
 
 
+haddockPath = ".." </> "dist" </> "build" </> "haddock" </> "haddock"
+
+
 main = do
   test
   putStrLn "All tests passed!"
 
 
-haddockEq file1 file2 = stripLinks file1 == stripLinks file2
+test = do
+  x <- doesFileExist haddockPath
+  when (not x) $ die "you need to run 'cabal build' successfully first"
 
-stripLinks f = subRegex (mkRegexWithOpts "<A HREF=[^>]*>" False False) f "<A HREF=\"\">"
+  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
 
-programOnPath p = do
-  result <- findProgramLocation silent p
-  return (isJust result)
+  let outdir = "output"
+  let mods' = map ("tests" </>) mods
+  putStrLn ""
+  putStrLn "Haddock version: "
+  h1 <- runProcess haddockPath ["--version"] Nothing
+                   (Just [("haddock_datadir", "../.")]) Nothing Nothing Nothing
+  waitForProcess h1
+  putStrLn ""
+  putStrLn "GHC version: "
+  h2 <- runProcess haddockPath ["--ghc-version"] Nothing
+                   (Just [("haddock_datadir", "../.")]) Nothing Nothing Nothing
+  waitForProcess h2
+  putStrLn ""
+
+  libdir <- rawSystemStdout normal haddockPath ["--print-ghc-libdir"]
+  let basepath = init libdir ++ "/../../share/doc/ghc/html/libraries/base-4.2.0.0/"
+  let base = "-i " ++ basepath ++ "," ++ basepath ++ "base.haddock"
+  let processpath = init libdir ++ "/../../share/doc/ghc/html/libraries/process-1.0.1.2/"
+  let process = "-i " ++ processpath ++ "," ++ processpath ++ "process.haddock"
+
+  putStrLn "Running tests..."
+  handle <- runProcess haddockPath
+                       (["-w", "-o", outdir, "-h", "--optghc=-fglasgow-exts"
+                        , "--optghc=-w", base, process] ++ opts ++ 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)
 
 
 check modules strict = do
@@ -58,39 +96,13 @@ check modules strict = do
         putStrLn $ "Pass: " ++ mod ++ " (no .ref file)"
 
 
-test = do
+haddockEq file1 file2 = stripLinks file1 == stripLinks file2
 
-  x <- doesFileExist (".." </> "dist" </> "build" </> "haddock" </> "haddock")
-  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
+stripLinks f = subRegex (mkRegexWithOpts "<A HREF=[^>]*>" False False) f "<A HREF=\"\">"
 
-  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-4.2.0.0/"
-  let base = "-i " ++ basepath ++ "," ++ basepath ++ "base.haddock"
-  let processpath = init libdir ++ "/../../share/doc/ghc/html/libraries/process-1.0.1.2/"
-  let process = "-i " ++ processpath ++ "," ++ processpath ++ "process.haddock"
+programOnPath p = do
+  result <- findProgramLocation silent p
+  return (isJust result)
 
-  putStrLn "Running tests..."
-  handle <- runProcess "../dist/build/haddock/haddock" (["-w", "-o", outdir, "-h", "--optghc=-fglasgow-exts", "--optghc=-w", base, process] ++ opts ++ 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)
-- 
cgit v1.2.3