From 3c88a8a3336b26939738d481a60233821b926adb Mon Sep 17 00:00:00 2001 From: Ɓukasz Hanuszczak Date: Mon, 24 Aug 2015 23:14:18 +0200 Subject: Get rid of obsolete testing utilities. --- hypsrc-test/run.hs | 122 ----------------------------------------------------- 1 file changed, 122 deletions(-) delete mode 100755 hypsrc-test/run.hs (limited to 'hypsrc-test/run.hs') diff --git a/hypsrc-test/run.hs b/hypsrc-test/run.hs deleted file mode 100755 index 853c4f09..00000000 --- a/hypsrc-test/run.hs +++ /dev/null @@ -1,122 +0,0 @@ -#!/usr/bin/env runhaskell -{-# LANGUAGE CPP #-} - - -import Control.Monad - -import Data.List -import Data.Maybe - -import System.Directory -import System.Environment -import System.Exit -import System.FilePath -import System.Process - -import Distribution.Verbosity -import Distribution.Simple.Utils hiding (die) - -import Utils - - -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 ) <$> case args of - [] -> getAllSrcModules - _ -> return $ map (++ ".hs") mods - - putHaddockVersion - putGhcVersion - - putStrLn "Running tests..." - runHaddock $ - [ "--odir=" ++ outDir - , "--no-warnings" - , "--hyperlinked-source" - , "--pretty-html" - ] ++ args' ++ mods' - - forM_ mods' $ check True - - -check :: Bool -> FilePath -> IO () -check strict mdl = do - hasReference <- doesFileExist refFile - if hasReference - then do - ref <- readFile refFile - out <- readFile outFile - compareOutput strict mdl ref out - else do - putStrLn $ "Pass: " ++ mdl ++ " (no reference file)" - where - refFile = refDir' takeBaseName mdl ++ ".html" - outFile = outDir' takeBaseName mdl ++ ".html" - - -compareOutput :: Bool -> FilePath -> String -> String -> IO () -compareOutput strict mdl ref out = do - if ref' == out' - then putStrLn $ "Pass: " ++ mdl - else do - putStrLn $ "Fail: " ++ mdl - diff mdl ref' out' - when strict $ die "Aborting further tests." - where - ref' = stripLocalReferences ref - out' = stripLocalReferences out - - -diff :: FilePath -> String -> String -> IO () -diff mdl ref out = do - colorDiffPath <- findProgramLocation silent "colordiff" - let cmd = fromMaybe "diff" colorDiffPath - - writeFile refFile ref - writeFile outFile out - - result <- system $ cmd ++ " " ++ refFile ++ " " ++ outFile - unless (result == ExitSuccess) $ die "Failed to run `diff` command." - where - refFile = outDir takeBaseName mdl ++ ".ref.nolinks" - outFile = outDir takeBaseName mdl ++ ".nolinks" - - - -getAllSrcModules :: IO [FilePath] -getAllSrcModules = - filter isHaskellFile <$> getDirectoryContents srcDir - where - isHaskellFile = (== ".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 - menv <- Just <$> getEnvironment - handle <- runProcess haddockPath args Nothing menv 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 -- cgit v1.2.3