Commit 4ab21cb2 authored by Neil Vice's avatar Neil Vice Committed by ttuegel
Browse files

Enable hpc with LocalBuildInfo flag

parent c26c8385
......@@ -75,7 +75,7 @@ import Distribution.PackageDescription.Configuration
( finalizePackageDescription, mapTreeData )
import Distribution.PackageDescription.Check
( PackageCheck(..), checkPackage, checkPackageFiles )
import Distribution.Simple.Hpc ( enableCoverage )
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.Program
( Program(..), ProgramLocation(..), ConfiguredProgram(..)
, ProgramConfiguration, defaultProgramConfiguration
......@@ -411,9 +411,7 @@ configure (pkg_descr0, pbi) cfg
-- add extra include/lib dirs as specified in cfg
-- we do it here so that those get checked too
let pkg_descr =
enableCoverage (fromFlag (configLibCoverage cfg)) distPref
$ addExtraIncludeLibDirs pkg_descr0'
let pkg_descr = addExtraIncludeLibDirs pkg_descr0'
when (not (null flags)) $
info verbosity $ "Flags chosen: "
......@@ -599,7 +597,10 @@ configure (pkg_descr0, pbi) cfg
stripLibs = fromFlag $ configStripLibs cfg,
withPackageDB = packageDbs,
progPrefix = fromFlag $ configProgPrefix cfg,
progSuffix = fromFlag $ configProgSuffix cfg
progSuffix = fromFlag $ configProgSuffix cfg,
withCoverage = if fromFlag $ configLibCoverage cfg
then Just $ Hpc.mixDir distPref (display $ package pkg_descr')
else Nothing
}
let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
......
......@@ -1186,14 +1186,14 @@ 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)
ghcOptExtensionMap = compilerExtensions (compiler lbi),
ghcOptHPCDir = maybe mempty toFlag (withCoverage lbi)
}
where
toGhcOptimisation NoOptimisation = mempty --TODO perhaps override?
toGhcOptimisation NormalOptimisation = toFlag GhcNormalOptimisation
toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation
componentCcGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath
......
......@@ -12,7 +12,7 @@
-- build test suites with HPC enabled.
module Distribution.Simple.Hpc
( enableCoverage
( mixDir
, htmlDir
, tixDir
, tixFilePath
......@@ -21,13 +21,9 @@ module Distribution.Simple.Hpc
) where
import Control.Monad ( when )
import Distribution.Compiler ( CompilerFlavor(..) )
import Distribution.ModuleName ( main )
import Distribution.PackageDescription
( BuildInfo(..)
, Library(..)
, PackageDescription(..)
, TestSuite(..)
( TestSuite(..)
, testModules
)
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
......@@ -38,7 +34,6 @@ import Distribution.Simple.Program
import Distribution.Simple.Program.Hpc ( markup, union )
import Distribution.Simple.Utils ( notice )
import Distribution.Version ( anyVersion )
import Distribution.Text
import Distribution.Verbosity ( Verbosity() )
import System.Directory ( createDirectoryIfMissing, doesFileExist )
import System.FilePath
......@@ -46,38 +41,6 @@ import System.FilePath
-- -------------------------------------------------------------------------
-- Haskell Program Coverage
-- | Conditionally enable Haskell Program Coverage by adding the necessary
-- GHC options to a PackageDescription.
--
-- TODO: do this differently in the build stage by constructing local build
-- info, not by modifying the original PackageDescription.
--
enableCoverage :: Bool -- ^ Enable coverage?
-> String -- ^ \"dist/\" prefix
-> PackageDescription
-> PackageDescription
enableCoverage False _ x = x
enableCoverage True distPref p =
p { library = fmap enableLibCoverage (library p)
, testSuites = map enableTestCoverage (testSuites p)
}
where
enableBICoverage name oldBI =
let oldOptions = options oldBI
oldGHCOpts = lookup GHC oldOptions
newGHCOpts = case oldGHCOpts of
Just xs -> (GHC, hpcOpts ++ xs)
_ -> (GHC, hpcOpts)
newOptions = (:) newGHCOpts $ filter ((== GHC) . fst) oldOptions
hpcOpts = ["-fhpc", "-hpcdir", mixDir distPref name]
in oldBI { options = newOptions }
enableLibCoverage l =
l { libBuildInfo = enableBICoverage (display $ package p)
(libBuildInfo l)
}
enableTestCoverage t =
t { testBuildInfo = enableBICoverage (testName t) (testBuildInfo t) }
hpcDir :: FilePath -- ^ \"dist/\" prefix
-> FilePath -- ^ Directory containing component's HPC .mix files
hpcDir distPref = distPref </> "hpc"
......
......@@ -138,7 +138,8 @@ 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
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.
} deriving (Generic, Read, Show)
instance Binary LocalBuildInfo
......
......@@ -151,6 +151,9 @@ data GhcOptions = GhcOptions {
-- | Run N jobs simultaneously (if possible).
ghcOptNumJobs :: Flag Int,
-- | Enable coverage analysis; the @ghc -fhpc -hpcdir@ flags.
ghcOptHPCDir :: Flag FilePath,
----------------
-- GHCi
......@@ -263,6 +266,9 @@ renderGhcOptions comp opts
, [ "-split-objs" | flagBool ghcOptSplitObjs ]
, case flagToMaybe (ghcOptHPCDir opts) of
Nothing -> []
Just hpcdir -> ["-fhpc", "-hpcdir", hpcdir]
, if parmakeSupported comp
then
......@@ -442,6 +448,7 @@ instance Monoid GhcOptions where
ghcOptProfilingMode = mempty,
ghcOptSplitObjs = mempty,
ghcOptNumJobs = mempty,
ghcOptHPCDir = mempty,
ghcOptGHCiScripts = mempty,
ghcOptHiSuffix = mempty,
ghcOptObjSuffix = mempty,
......@@ -491,6 +498,7 @@ instance Monoid GhcOptions where
ghcOptProfilingMode = combine ghcOptProfilingMode,
ghcOptSplitObjs = combine ghcOptSplitObjs,
ghcOptNumJobs = combine ghcOptNumJobs,
ghcOptHPCDir = combine ghcOptHPCDir,
ghcOptGHCiScripts = combine ghcOptGHCiScripts,
ghcOptHiSuffix = combine ghcOptHiSuffix,
ghcOptObjSuffix = combine ghcOptObjSuffix,
......
......@@ -36,6 +36,7 @@ import Distribution.TestSuite ( Result(..) )
import Distribution.Text
import Control.Monad ( when, unless, filterM )
import Data.Maybe ( isJust )
import System.Directory
( createDirectoryIfMissing, doesFileExist, getDirectoryContents
, removeFile )
......@@ -117,8 +118,9 @@ test args pkg_descr lbi flags = do
allOk <- summarizePackage verbosity packageLog
writeFile packageLogFile $ show packageLog
markupPackage verbosity lbi distPref (display $ PD.package pkg_descr)
$ map fst testsToRun
when (isJust $ LBI.withCoverage lbi) $
markupPackage verbosity lbi distPref (display $ PD.package pkg_descr) $
map fst testsToRun
unless allOk exitFailure
......
......@@ -22,6 +22,7 @@ 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 )
......@@ -71,10 +72,9 @@ runTest pkg_descr lbi flags suite = do
let opts = map (testOption pkg_descr lbi suite)
(testOptions flags)
dataDirPath = pwd </> PD.dataDir pkg_descr
tixFile = pwd </> (tixFilePath distPref $ PD.testName suite)
shellEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath)
: ("HPCTIXFILE", tixFile)
: existingEnv
tixFile = pwd </> tixFilePath distPref (PD.testName suite)
pkgPathEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath) : existingEnv
shellEnv = [("HPCTIXFILE", tixFile) | isJust $ LBI.withCoverage lbi] ++ pkgPathEnv
exit <- rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv)
-- these handles are automatically closed
Nothing (Just wOut) (Just wOut)
......@@ -107,8 +107,9 @@ runTest pkg_descr lbi flags suite = do
-- Write summary notice to terminal indicating end of test suite
notice verbosity $ summarizeSuiteFinish suiteLog
markupTest verbosity lbi distPref
(display $ PD.package pkg_descr) suite
when (isJust $ LBI.withCoverage lbi) $
markupTest verbosity lbi distPref
(display $ PD.package pkg_descr) suite
return suiteLog
where
......
......@@ -28,7 +28,7 @@ import Distribution.Verbosity ( normal )
import Control.Exception ( bracket )
import Control.Monad ( when, unless )
import Data.Maybe ( mapMaybe )
import Data.Maybe ( isJust, mapMaybe )
import System.Directory
( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
, getCurrentDirectory, removeDirectoryRecursive, removeFile
......@@ -78,10 +78,9 @@ runTest pkg_descr lbi flags suite = do
-- Run test executable
_ <- do let opts = map (testOption pkg_descr lbi suite) $ testOptions flags
dataDirPath = pwd </> PD.dataDir pkg_descr
shellEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath)
: ("HPCTIXFILE", (</>) pwd
$ tixFilePath distPref $ PD.testName suite)
: existingEnv
tixFile = pwd </> tixFilePath distPref (PD.testName suite)
pkgPathEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath) : existingEnv
shellEnv = [("HPCTIXFILE", tixFile) | isJust $ LBI.withCoverage lbi] ++ pkgPathEnv
rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv)
-- these handles are closed automatically
(Just rIn) (Just wOut) (Just wOut)
......@@ -120,8 +119,9 @@ runTest pkg_descr lbi flags suite = do
-- Write summary notice to terminal indicating end of test suite
notice verbosity $ summarizeSuiteFinish suiteLog
markupTest verbosity lbi distPref
(display $ PD.package pkg_descr) suite
when (isJust $ LBI.withCoverage lbi) $
markupTest verbosity lbi distPref
(display $ PD.package pkg_descr) suite
return suiteLog
where
......
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