Commit 2cd6d622 authored by ttuegel's avatar ttuegel
Browse files

Enable program coverage for all components

parent 4ab21cb2
......@@ -75,7 +75,6 @@ import Distribution.PackageDescription.Configuration
( finalizePackageDescription, mapTreeData )
import Distribution.PackageDescription.Check
( PackageCheck(..), checkPackage, checkPackageFiles )
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.Program
( Program(..), ProgramLocation(..), ConfiguredProgram(..)
, ProgramConfiguration, defaultProgramConfiguration
......@@ -597,10 +596,7 @@ configure (pkg_descr0, pbi) cfg
stripLibs = fromFlag $ configStripLibs cfg,
withPackageDB = packageDbs,
progPrefix = fromFlag $ configProgPrefix cfg,
progSuffix = fromFlag $ configProgSuffix cfg,
withCoverage = if fromFlag $ configLibCoverage cfg
then Just $ Hpc.mixDir distPref (display $ package pkg_descr')
else Nothing
progSuffix = fromFlag $ configProgSuffix cfg
}
let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
......
......@@ -62,6 +62,7 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
, LibraryName(..), absoluteInstallDirs )
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
......@@ -85,7 +86,7 @@ import qualified Distribution.Simple.Program.Ld as Ld
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
( toFlag, fromFlag, fromFlagOrDefault )
( toFlag, fromFlag, fromFlagOrDefault, configCoverage, configDistPref )
import qualified Distribution.Simple.Setup as Cabal
( Flag )
import Distribution.Simple.Compiler
......@@ -703,11 +704,22 @@ buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do
forceSharedLib = doingTH && isGhcDynamic
-- TH always needs default libs, even when building for profiling
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi
-- Component name. Not 'libName' because that has the "HS" prefix
-- that GHC gives Haskell libraries.
cname = display $ PD.package $ localPkgDescr lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir | isCoverageEnabled = toFlag $ Hpc.mixDir distPref cname
| otherwise = mempty
createDirectoryIfMissingVerbose verbosity True libTargetDir
-- TODO: do we need to put hs-boot files into place for mutually recursive
-- modules?
let cObjs = map (`replaceExtension` objExtension) (cSources libBi)
baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
`mappend` mempty { ghcOptHPCDir = hpcdir }
vanillaOpts = baseOpts `mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
ghcOptNumJobs = toFlag numJobs,
......@@ -943,6 +955,13 @@ buildOrReplExe forRepl verbosity numJobsFlag _pkg_descr lbi
-- TODO: do we need to put hs-boot files into place for mutually recursive
-- modules? FIX: what about exeName.hi-boot?
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir | isCoverageEnabled = toFlag $ Hpc.mixDir distPref exeName'
| otherwise = mempty
-- build executables
srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath
......@@ -957,7 +976,8 @@ buildOrReplExe forRepl verbosity numJobsFlag _pkg_descr lbi
ghcOptInputFiles =
[ srcMainFile | isHaskellMain],
ghcOptInputModules =
[ m | not isHaskellMain, m <- exeModules exe]
[ m | not isHaskellMain, m <- exeModules exe],
ghcOptHPCDir = hpcdir
}
staticOpts = baseOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcStaticOnly
......@@ -1186,8 +1206,7 @@ componentGhcOptions verbosity lbi bi clbi odir =
ghcOptLanguage = toFlag (fromMaybe Haskell98 (defaultLanguage bi)),
-- Unsupported extensions have already been checked by configure
ghcOptExtensions = usedExtensions bi,
ghcOptExtensionMap = compilerExtensions (compiler lbi),
ghcOptHPCDir = maybe mempty toFlag (withCoverage lbi)
ghcOptExtensionMap = compilerExtensions (compiler lbi)
}
where
toGhcOptimisation NoOptimisation = mempty --TODO perhaps override?
......
......@@ -138,8 +138,7 @@ data LocalBuildInfo = LocalBuildInfo {
stripExes :: Bool, -- ^Whether to strip executables during install
stripLibs :: Bool, -- ^Whether to strip libraries during install
progPrefix :: PathTemplate, -- ^Prefix to be prepended to installed executables
progSuffix :: PathTemplate, -- ^Suffix to be appended to installed executables
withCoverage :: Maybe String -- ^Whether to build with library coverage and if so where to put the output.
progSuffix :: PathTemplate -- ^Suffix to be appended to installed executables
} deriving (Generic, Read, Show)
instance Binary LocalBuildInfo
......
......@@ -296,8 +296,7 @@ data ConfigFlags = ConfigFlags {
configConfigurationsFlags :: FlagAssignment,
configTests :: Flag Bool, -- ^Enable test suite compilation
configBenchmarks :: Flag Bool, -- ^Enable benchmark compilation
configLibCoverage :: Flag Bool,
-- ^Enable test suite program coverage.
configCoverage :: Flag Bool, -- ^Enable program coverage
configExactConfiguration :: Flag Bool
-- ^All direct dependencies and flags are provided on the command line by
-- the user via the '--dependency' and '--flags' options.
......@@ -338,7 +337,7 @@ defaultConfigFlags progConf = emptyConfigFlags {
configStripLibs = Flag True,
configTests = Flag False,
configBenchmarks = Flag False,
configLibCoverage = Flag False,
configCoverage = Flag False,
configExactConfiguration = Flag False
}
......@@ -523,9 +522,9 @@ configureOptions showOrParseArgs =
configTests (\v flags -> flags { configTests = v })
(boolOpt [] [])
,option "" ["library-coverage"]
"build library and test suites with Haskell Program Coverage enabled. (GHC only)"
configLibCoverage (\v flags -> flags { configLibCoverage = v })
,option "" ["coverage"]
"build package with Haskell Program Coverage enabled. (GHC only)"
configCoverage (\v flags -> flags { configCoverage = v })
(boolOpt [] [])
,option "" ["exact-configuration"]
......@@ -677,7 +676,7 @@ instance Monoid ConfigFlags where
configExtraIncludeDirs = mempty,
configConfigurationsFlags = mempty,
configTests = mempty,
configLibCoverage = mempty,
configCoverage = mempty,
configExactConfiguration = mempty,
configBenchmarks = mempty
}
......@@ -714,7 +713,7 @@ instance Monoid ConfigFlags where
configExtraIncludeDirs = combine configExtraIncludeDirs,
configConfigurationsFlags = combine configConfigurationsFlags,
configTests = combine configTests,
configLibCoverage = combine configLibCoverage,
configCoverage = combine configCoverage,
configExactConfiguration = combine configExactConfiguration,
configBenchmarks = combine configBenchmarks
}
......
......@@ -26,7 +26,7 @@ import Distribution.Simple.InstallDirs
, PathTemplate )
import qualified Distribution.Simple.LocalBuildInfo as LBI
( LocalBuildInfo(..) )
import Distribution.Simple.Setup ( TestFlags(..), fromFlag )
import Distribution.Simple.Setup ( TestFlags(..), fromFlag, configCoverage )
import Distribution.Simple.UserHooks ( Args )
import qualified Distribution.Simple.Test.ExeV10 as ExeV10
import qualified Distribution.Simple.Test.LibV09 as LibV09
......@@ -36,7 +36,6 @@ import Distribution.TestSuite ( Result(..) )
import Distribution.Text
import Control.Monad ( when, unless, filterM )
import Data.Maybe ( isJust )
import System.Directory
( createDirectoryIfMissing, doesFileExist, getDirectoryContents
, removeFile )
......@@ -118,7 +117,8 @@ test args pkg_descr lbi flags = do
allOk <- summarizePackage verbosity packageLog
writeFile packageLogFile $ show packageLog
when (isJust $ LBI.withCoverage lbi) $
let isCoverageEnabled = fromFlag $ configCoverage $ LBI.configFlags lbi
when isCoverageEnabled $
markupPackage verbosity lbi distPref (display $ PD.package pkg_descr) $
map fst testsToRun
......
......@@ -13,7 +13,8 @@ import Distribution.Simple.InstallDirs
( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..)
, substPathTemplate , toPathTemplate, PathTemplate )
import qualified Distribution.Simple.LocalBuildInfo as LBI
import Distribution.Simple.Setup ( TestFlags(..), TestShowDetails(..), fromFlag )
import Distribution.Simple.Setup
( TestFlags(..), TestShowDetails(..), fromFlag, configCoverage )
import Distribution.Simple.Test.Log
import Distribution.Simple.Utils ( die, notice, rawSystemIOWithEnv )
import Distribution.TestSuite
......@@ -22,7 +23,6 @@ import Distribution.Verbosity ( normal )
import Control.Concurrent (forkIO)
import Control.Monad ( unless, void, when )
import Data.Maybe (isJust)
import System.Directory
( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
, getCurrentDirectory, removeDirectoryRecursive )
......@@ -36,6 +36,8 @@ runTest :: PD.PackageDescription
-> PD.TestSuite
-> IO TestSuiteLog
runTest pkg_descr lbi flags suite = do
let isCoverageEnabled = fromFlag $ configCoverage $ LBI.configFlags lbi
pwd <- getCurrentDirectory
existingEnv <- getEnvironment
......@@ -73,8 +75,9 @@ runTest pkg_descr lbi flags suite = do
(testOptions flags)
dataDirPath = pwd </> PD.dataDir pkg_descr
tixFile = pwd </> tixFilePath distPref (PD.testName suite)
pkgPathEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath) : existingEnv
shellEnv = [("HPCTIXFILE", tixFile) | isJust $ LBI.withCoverage lbi] ++ pkgPathEnv
pkgPathEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath)
: existingEnv
shellEnv = [("HPCTIXFILE", tixFile) | isCoverageEnabled] ++ pkgPathEnv
exit <- rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv)
-- these handles are automatically closed
Nothing (Just wOut) (Just wOut)
......@@ -107,9 +110,8 @@ runTest pkg_descr lbi flags suite = do
-- Write summary notice to terminal indicating end of test suite
notice verbosity $ summarizeSuiteFinish suiteLog
when (isJust $ LBI.withCoverage lbi) $
markupTest verbosity lbi distPref
(display $ PD.package pkg_descr) suite
when isCoverageEnabled $
markupTest verbosity lbi distPref (display $ PD.package pkg_descr) suite
return suiteLog
where
......
......@@ -19,7 +19,8 @@ import Distribution.Simple.InstallDirs
( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..)
, substPathTemplate , toPathTemplate, PathTemplate )
import qualified Distribution.Simple.LocalBuildInfo as LBI
import Distribution.Simple.Setup ( TestFlags(..), TestShowDetails(..), fromFlag )
import Distribution.Simple.Setup
( TestFlags(..), TestShowDetails(..), fromFlag, configCoverage )
import Distribution.Simple.Test.Log
import Distribution.Simple.Utils ( die, notice, rawSystemIOWithEnv )
import Distribution.TestSuite
......@@ -28,7 +29,7 @@ import Distribution.Verbosity ( normal )
import Control.Exception ( bracket )
import Control.Monad ( when, unless )
import Data.Maybe ( isJust, mapMaybe )
import Data.Maybe ( mapMaybe )
import System.Directory
( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
, getCurrentDirectory, removeDirectoryRecursive, removeFile
......@@ -43,6 +44,8 @@ runTest :: PD.PackageDescription
-> PD.TestSuite
-> IO TestSuiteLog
runTest pkg_descr lbi flags suite = do
let isCoverageEnabled = fromFlag $ configCoverage $ LBI.configFlags lbi
pwd <- getCurrentDirectory
existingEnv <- getEnvironment
......@@ -79,8 +82,10 @@ runTest pkg_descr lbi flags suite = do
_ <- do let opts = map (testOption pkg_descr lbi suite) $ testOptions flags
dataDirPath = pwd </> PD.dataDir pkg_descr
tixFile = pwd </> tixFilePath distPref (PD.testName suite)
pkgPathEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath) : existingEnv
shellEnv = [("HPCTIXFILE", tixFile) | isJust $ LBI.withCoverage lbi] ++ pkgPathEnv
pkgPathEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath)
: existingEnv
shellEnv = [("HPCTIXFILE", tixFile) | isCoverageEnabled]
++ pkgPathEnv
rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv)
-- these handles are closed automatically
(Just rIn) (Just wOut) (Just wOut)
......@@ -119,9 +124,8 @@ runTest pkg_descr lbi flags suite = do
-- Write summary notice to terminal indicating end of test suite
notice verbosity $ summarizeSuiteFinish suiteLog
when (isJust $ LBI.withCoverage lbi) $
markupTest verbosity lbi distPref
(display $ PD.package pkg_descr) suite
when isCoverageEnabled $
markupTest verbosity lbi distPref (display $ PD.package pkg_descr) suite
return suiteLog
where
......
......@@ -31,7 +31,7 @@ checkTestWithHpc :: FilePath -> Test
checkTestWithHpc ghcPath = TestCase $ do
isCorrectVersion <- correctHpcVersion
when isCorrectVersion $ do
buildAndTest ghcPath [] ["--enable-library-coverage"]
buildAndTest ghcPath [] ["--enable-coverage"]
let dummy = emptyTestSuite { testName = "test-Foo" }
tixFile = tixFilePath (dir </> "dist") $ testName dummy
tixFileMessage = ".tix file should exist"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment