aboutsummaryrefslogtreecommitdiff
path: root/hypsrc-test/run.hs
diff options
context:
space:
mode:
authorŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-06-30 19:38:21 +0200
committerŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-06-30 22:37:50 +0200
commit5f13457a8e31f424d797f721e93434e09bc9140a (patch)
treea8b1b5de686659f3839f5fe98271c30a1e40a773 /hypsrc-test/run.hs
parent5ddb425bbdc29efdd314ffc18db6c8e6c3609d24 (diff)
Create simple test runner for hyperlinker tests.
Diffstat (limited to 'hypsrc-test/run.hs')
-rwxr-xr-xhypsrc-test/run.hs119
1 files changed, 119 insertions, 0 deletions
diff --git a/hypsrc-test/run.hs b/hypsrc-test/run.hs
new file mode 100755
index 00000000..0b97a075
--- /dev/null
+++ b/hypsrc-test/run.hs
@@ -0,0 +1,119 @@
+#!/usr/bin/env runhaskell
+{-# LANGUAGE CPP #-}
+
+
+import Control.Applicative
+import Control.Monad
+
+import Data.List
+import Data.Maybe
+
+import System.IO
+import System.Directory
+import System.Environment
+import System.Exit
+import System.FilePath
+import System.Process
+
+import Distribution.Verbosity
+import Distribution.Simple.Utils hiding (die)
+
+
+baseDir, rootDir :: FilePath
+baseDir = takeDirectory __FILE__
+rootDir = baseDir </> ".."
+
+srcDir, refDir, outDir :: FilePath
+srcDir = baseDir </> "src"
+refDir = baseDir </> "ref"
+outDir = baseDir </> "out"
+
+haddockPath :: FilePath
+haddockPath = rootDir </> "dist" </> "build" </> "haddock" </> "haddock"
+
+
+main :: IO ()
+main = do
+ haddockAvailable <- doesFileExist haddockPath
+ unless haddockAvailable $ die "Haddock exectuable not available"
+
+ (args, mods) <- partition ("-" `isPrefixOf`) <$> getArgs
+ let args' = filter (\arg -> not $ arg == "--all" || arg == "-a") args
+ mods' <- map (srcDir </>) <$> if "--all" `elem` args || "-a" `elem` args
+ then getAllSrcModules
+ else return mods
+
+ putHaddockVersion
+ putGhcVersion
+
+ putStrLn "Running tests..."
+ runHaddock $
+ [ "--odir=" ++ outDir
+ , "--no-warnings"
+ , "--hyperlinked-source"
+ ] ++ args' ++ mods'
+
+ forM_ mods' $ check True
+
+
+check :: Bool -> FilePath -> IO ()
+check strict mdl = do
+ hasReference <- doesFileExist refFile
+ if hasReference
+ then do
+ out <- readFile outFile
+ ref <- readFile refFile
+ if out == ref
+ then putStrLn $ "Pass: " ++ mdl
+ else do
+ putStrLn $ "Fail: " ++ mdl
+ diff refFile outFile
+ when strict $ die "Aborting further tests."
+ else do
+ putStrLn $ "Pass: " ++ mdl ++ " (no reference file)"
+ where
+ refFile = refDir </> takeBaseName mdl ++ ".html"
+ outFile = outDir </> takeBaseName mdl ++ ".html"
+
+
+diff :: FilePath -> FilePath -> IO ()
+diff fileA fileB = do
+ colorDiffPath <- findProgramLocation silent "colordiff"
+ let cmd = fromMaybe "diff" colorDiffPath
+
+ result <- system $ cmd ++ " " ++ fileA ++ " " ++ fileB
+ unless (result == ExitSuccess) $ die "Failed to run `diff` command."
+
+
+getAllSrcModules :: IO [FilePath]
+getAllSrcModules =
+ filter isValid <$> getDirectoryContents srcDir
+ where
+ isValid = (== ".hs") . takeExtension
+
+
+putHaddockVersion :: IO ()
+putHaddockVersion = do
+ putStrLn "Haddock version:"
+ runHaddock ["--version"]
+ putStrLn ""
+
+
+putGhcVersion :: IO ()
+putGhcVersion = do
+ putStrLn "GHC version:"
+ runHaddock ["--ghc-version"]
+ putStrLn ""
+
+
+runHaddock :: [String] -> IO ()
+runHaddock args = do
+ env <- Just <$> getEnvironment
+ handle <- runProcess haddockPath args Nothing env Nothing Nothing Nothing
+ waitForSuccess handle $ "Failed to invoke haddock with " ++ show args
+
+
+waitForSuccess :: ProcessHandle -> String -> IO ()
+waitForSuccess handle msg = do
+ result <- waitForProcess handle
+ unless (result == ExitSuccess) $ die msg