diff options
author | David Waern <david.waern@gmail.com> | 2010-05-11 19:14:31 +0000 |
---|---|---|
committer | David Waern <david.waern@gmail.com> | 2010-05-11 19:14:31 +0000 |
commit | a7cfb1d83c7e0f97a806e1f2c202416e625b2ce2 (patch) | |
tree | a4154de09f38ddee5e17bc16bfac323a41d9b7b5 /tests/runtests.hs | |
parent | c7d9f7678de931e580a3fe1bec2fb0e2dead84d3 (diff) |
Re-organise the testsuite structure
Diffstat (limited to 'tests/runtests.hs')
-rw-r--r-- | tests/runtests.hs | 114 |
1 files changed, 0 insertions, 114 deletions
diff --git a/tests/runtests.hs b/tests/runtests.hs deleted file mode 100644 index 99a47828..00000000 --- a/tests/runtests.hs +++ /dev/null @@ -1,114 +0,0 @@ -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 - - -haddockPath = ".." </> "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", "../.")]) Nothing Nothing Nothing - waitForProcess h1 - putStrLn "" - putStrLn "GHC version: " - h2 <- runProcess haddockPath ["--ghc-version"] Nothing - (Just [("haddock_datadir", "../.")]) 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.0" - process = mkDep "process" "1.0.1.2" - 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", "../.")]) 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) - |