From b89b21a6d75c5498d4ebc19e8d099c1b91c44182 Mon Sep 17 00:00:00 2001 From: David Waern Date: Mon, 6 Dec 2010 14:25:37 +0000 Subject: Rename golden-tests into html-tests. "golden tests" sounds strange --- tests/golden-tests/runtests.hs | 115 ----------------------------------------- 1 file changed, 115 deletions(-) delete mode 100644 tests/golden-tests/runtests.hs (limited to 'tests/golden-tests/runtests.hs') diff --git a/tests/golden-tests/runtests.hs b/tests/golden-tests/runtests.hs deleted file mode 100644 index 05bc28c5..00000000 --- a/tests/golden-tests/runtests.hs +++ /dev/null @@ -1,115 +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 - - -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.3.0.0" - process = mkDep "process" "1.0.1.4" - ghcprim = mkDep "ghc-prim" "0.2.0.0" - - putStrLn "Running tests..." - handle <- runProcess haddockPath - (["-w", "-o", outdir, "-h", "--pretty-html", "--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 "]*>" False False) f "" - - -programOnPath p = do - result <- findProgramLocation silent p - return (isJust result) - -- cgit v1.2.3