module PackageTests.TestSuiteExeV10.Check (checks) where import qualified Control.Exception as E (IOException, catch) import Control.Monad (when) import Data.Maybe (catMaybes) import System.Directory ( doesFileExist ) import System.FilePath import qualified Test.Framework as TF import Test.Framework (testGroup) import Test.Framework.Providers.HUnit (hUnitTestToTests) import Test.HUnit hiding ( path ) import Distribution.Simple.Configure (getPersistBuildConfig) import Distribution.Simple.Hpc import Distribution.Simple.Program.Builtin (hpcProgram) import Distribution.Simple.Program.Db ( emptyProgramDb, configureProgram, requireProgramVersion ) import qualified Distribution.Verbosity as Verbosity import Distribution.Version (Version(..), orLaterVersion) import PackageTests.PackageTester checks :: FilePath -> [TF.Test] checks ghcPath = [ hunit "Test" $ checkTest ghcPath ] ++ hpcTestMatrix ghcPath ++ [ hunit "TestNoHpc/NoTix" $ checkTestNoHpcNoTix ghcPath , hunit "TestNoHpc/NoMarkup" $ checkTestNoHpcNoMarkup ghcPath ] hpcTestMatrix :: FilePath -> [TF.Test] hpcTestMatrix ghcPath = do libProf <- [True, False] exeProf <- [True, False] exeDyn <- [True, False] shared <- [True, False] let name = concat [ "WithHpc-" , if libProf then "LibProf" else "" , if exeProf then "ExeProf" else "" , if exeDyn then "ExeDyn" else "" , if shared then "Shared" else "" ] enable cond flag | cond = Just $ "--enable-" ++ flag | otherwise = Nothing opts = catMaybes [ enable libProf "library-profiling" , enable exeProf "profiling" , enable exeDyn "executable-dynamic" , enable shared "shared" ] return $ hunit name $ checkTestWithHpc ghcPath name opts dir :: FilePath dir = "PackageTests" "TestSuiteExeV10" checkTest :: FilePath -> Test checkTest ghcPath = TestCase $ buildAndTest ghcPath "Default" [] [] shouldExist :: FilePath -> Assertion shouldExist path = doesFileExist path >>= assertBool (path ++ " should exist") shouldNotExist :: FilePath -> Assertion shouldNotExist path = doesFileExist path >>= assertBool (path ++ " should exist") . not -- | Ensure that both .tix file and markup are generated if coverage is enabled. checkTestWithHpc :: FilePath -> String -> [String] -> Test checkTestWithHpc ghcPath name extraOpts = TestCase $ do isCorrectVersion <- correctHpcVersion when isCorrectVersion $ do buildAndTest ghcPath name [] ("--enable-coverage" : extraOpts) lbi <- getPersistBuildConfig (dir "dist-" ++ name) let way = guessWay lbi mapM_ shouldExist [ mixDir (dir "dist-" ++ name) way "my-0.1" "my-0.1" "Foo.mix" , mixDir (dir "dist-" ++ name) way "test-Foo" "Main.mix" , tixFilePath (dir "dist-" ++ name) way "test-Foo" , htmlDir (dir "dist-" ++ name) way "test-Foo" "hpc_index.html" ] -- | Ensures that even if -fhpc is manually provided no .tix file is output. checkTestNoHpcNoTix :: FilePath -> Test checkTestNoHpcNoTix ghcPath = TestCase $ do buildAndTest ghcPath "NoHpcNoTix" [] [ "--ghc-option=-fhpc" , "--ghc-option=-hpcdir" , "--ghc-option=dist-NoHpcNoTix/hpc/vanilla" ] lbi <- getPersistBuildConfig (dir "dist-NoHpcNoTix") let way = guessWay lbi shouldNotExist $ tixFilePath (dir "dist-NoHpcNoTix") way "test-Foo" -- | Ensures that even if a .tix file happens to be left around -- markup isn't generated. checkTestNoHpcNoMarkup :: FilePath -> Test checkTestNoHpcNoMarkup ghcPath = TestCase $ do let tixFile = tixFilePath "dist-NoHpcNoMarkup" Vanilla "test-Foo" buildAndTest ghcPath "NoHpcNoMarkup" [("HPCTIXFILE", Just tixFile)] [ "--ghc-option=-fhpc" , "--ghc-option=-hpcdir" , "--ghc-option=dist-NoHpcNoMarkup/hpc/vanilla" ] shouldNotExist $ htmlDir (dir "dist-NoHpcNoMarkup") Vanilla "test-Foo" "hpc_index.html" -- | Build and test a package and ensure that both were successful. -- -- The flag "--enable-tests" is provided in addition to the given flags. buildAndTest :: FilePath -> String -> [(String, Maybe String)] -> [String] -> IO () buildAndTest ghcPath name envOverrides flags = do let spec = PackageSpec { directory = dir , distPref = Just $ "dist-" ++ name , configOpts = "--enable-tests" : flags } buildResult <- cabal_build spec ghcPath assertBuildSucceeded buildResult testResult <- cabal_test spec envOverrides [] ghcPath assertTestSucceeded testResult hunit :: TF.TestName -> Test -> TF.Test hunit name = testGroup name . hUnitTestToTests -- | Checks for a suitable HPC version for testing. correctHpcVersion :: IO Bool correctHpcVersion = do let programDb' = emptyProgramDb let verbosity = Verbosity.normal let verRange = orLaterVersion (Version [0,7] []) programDb <- configureProgram verbosity hpcProgram programDb' (requireProgramVersion verbosity hpcProgram verRange programDb >> return True) `catchIO` (\_ -> return False) where -- Distribution.Compat.Exception is hidden. catchIO :: IO a -> (E.IOException -> IO a) -> IO a catchIO = E.catch