Skip to content

Commit

Permalink
Allow per-component builds with coverage enabled
Browse files Browse the repository at this point in the history
This commits re-enables per-component builds when coverage checking is
enabled. This restriction was previously added in #5004 to fix #4798.

However, the fix for #5213, in #7493, fixes the paths of the testsuite
`.mix` files to the same location as that of the main library component,
which in turn fixes #4798 as well -- meaning the restriction to treat
testsuites per-package (legacy-fallback) is no longer needed.

Lifting this restriction additionally fixes #6440 as we no longer
constrain coverage to per-package builds only, thus allowing multi-libs.

To generate hpc files in the appropriate component directories in the
distribution tree, we move the hack from #7493 from dictating the `.mix`
directories where hpc information is stored to dictating the `.mix`
directories that are included in the call to `hpc markup`.

Fixes #6440, and the already previously fixed #4798, #5213.
  • Loading branch information
alt-romes committed Nov 22, 2023
1 parent 1157461 commit aef4e35
Show file tree
Hide file tree
Showing 8 changed files with 84 additions and 40 deletions.
79 changes: 46 additions & 33 deletions Cabal/src/Distribution/Simple/Hpc.hs
Expand Up @@ -76,31 +76,7 @@ mixDir
-- ^ Component name
-> FilePath
-- ^ Directory containing test suite's .mix files
mixDir distPref way name = hpcDir distPrefBuild way </> "mix" </> name
where
-- This is a hack for HPC over test suites, needed to match the directory
-- where HPC saves and reads .mix files when the main library of the same
-- package is being processed, perhaps in a previous cabal run (#5213).
-- E.g., @distPref@ may be
-- @./dist-newstyle/build/x86_64-linux/ghc-9.0.1/cabal-gh5213-0.1/t/tests@
-- but the path where library mix files reside has two less components
-- at the end (@t/tests@) and this reduced path needs to be passed to
-- both @hpc@ and @ghc@. For non-default optimization levels, the path
-- suffix is one element longer and the extra path element needs
-- to be preserved.
distPrefElements = splitDirectories distPref
distPrefBuild = case drop (length distPrefElements - 3) distPrefElements of
["t", _, "noopt"] ->
joinPath $
take (length distPrefElements - 3) distPrefElements
++ ["noopt"]
["t", _, "opt"] ->
joinPath $
take (length distPrefElements - 3) distPrefElements
++ ["opt"]
[_, "t", _] ->
joinPath $ take (length distPrefElements - 2) distPrefElements
_ -> distPref
mixDir distPref way name = hpcDir distPref way </> "mix" </> name

tixDir
:: FilePath
Expand Down Expand Up @@ -146,14 +122,14 @@ markupTest
:: Verbosity
-> LocalBuildInfo
-> FilePath
-- ^ \"dist/\" prefix
-- ^ Testsuite \"dist/\" prefix
-> String
-- ^ Library name
-> TestSuite
-> Library
-> IO ()
markupTest verbosity lbi distPref libraryName suite library = do
tixFileExists <- doesFileExist $ tixFilePath distPref way $ testName'
markupTest verbosity lbi testDistPref libraryName suite library = do
tixFileExists <- doesFileExist $ tixFilePath testDistPref way $ testName'
when tixFileExists $ do
-- behaviour of 'markup' depends on version, so we need *a* version
-- but no particular one
Expand All @@ -163,12 +139,12 @@ markupTest verbosity lbi distPref libraryName suite library = do
hpcProgram
anyVersion
(withPrograms lbi)
let htmlDir_ = htmlDir distPref way testName'
let htmlDir_ = htmlDir testDistPref way testName'
markup
hpc
hpcVer
verbosity
(tixFilePath distPref way testName')
(tixFilePath testDistPref way testName')
mixDirs
htmlDir_
(exposedModules library)
Expand All @@ -179,14 +155,17 @@ markupTest verbosity lbi distPref libraryName suite library = do
where
way = guessWay lbi
testName' = unUnqualComponentName $ testName suite
mixDirs = map (mixDir distPref way) [testName', libraryName]
mixDirs =
[ mixDir testDistPref way testName'
, mixDir (pathToMainLibHpc testDistPref) way libraryName
]

-- | Generate the HTML markup for all of a package's test suites.
markupPackage
:: Verbosity
-> LocalBuildInfo
-> FilePath
-- ^ \"dist/\" prefix
-- ^ Testsuite \"dist/\" prefix
-> PD.PackageDescription
-> [TestSuite]
-> IO ()
Expand Down Expand Up @@ -215,6 +194,40 @@ markupPackage verbosity lbi distPref pkg_descr suites = do
where
way = guessWay lbi
testNames = fmap (unUnqualComponentName . testName) suites
mixDirs = map (mixDir distPref way) $ libraryName : testNames
mixDirs = mixDir (pathToMainLibHpc distPref) way libraryName : map (mixDir distPref way) testNames
included = concatMap (exposedModules) $ PD.allLibraries pkg_descr
libraryName = prettyShow $ PD.package pkg_descr

-- | A (non-exported) hack to determine the path to the main-lib hpc directory
-- given the testsuite's dist prefix.
--
-- We use this function when constructing calls to `hpc markup` since otherwise
-- having cabal-install communicate the path to the main lib dist-dir when
-- building the test component, via the Setup.hs interface, is far more
-- complicated.
pathToMainLibHpc :: FilePath -> FilePath
pathToMainLibHpc distPref = distPrefBuild
where
-- This is a hack for HPC over test suites, needed to match the directory
-- where HPC saves and reads .mix files when the main library of the same
-- package is being processed, perhaps in a previous cabal run (#5213).
-- E.g., @distPref@ may be
-- @./dist-newstyle/build/x86_64-linux/ghc-9.0.1/cabal-gh5213-0.1/t/tests@
-- but the path where library mix files reside has two less components
-- at the end (@t/tests@) and this reduced path needs to be passed to
-- both @hpc@ and @ghc@. For non-default optimization levels, the path
-- suffix is one element longer and the extra path element needs
-- to be preserved.
distPrefElements = splitDirectories distPref
distPrefBuild = case drop (length distPrefElements - 3) distPrefElements of
["t", _, "noopt"] ->
joinPath $
take (length distPrefElements - 3) distPrefElements
++ ["noopt"]
["t", _, "opt"] ->
joinPath $
take (length distPrefElements - 3) distPrefElements
++ ["opt"]
[_, "t", _] ->
joinPath $ take (length distPrefElements - 2) distPrefElements
_ -> distPref
8 changes: 1 addition & 7 deletions cabal-install/src/Distribution/Client/ProjectPlanning.hs
Expand Up @@ -1673,7 +1673,7 @@ elaborateInstallPlan
where
-- You are eligible to per-component build if this list is empty
why_not_per_component g =
cuz_buildtype ++ cuz_spec ++ cuz_length ++ cuz_flag ++ cuz_coverage
cuz_buildtype ++ cuz_spec ++ cuz_length ++ cuz_flag
where
cuz reason = [text reason]
-- We have to disable per-component for now with
Expand Down Expand Up @@ -1710,12 +1710,6 @@ elaborateInstallPlan
| fromFlagOrDefault True (projectConfigPerComponent sharedPackageConfig) =
[]
| otherwise = cuz "you passed --disable-per-component"
-- Enabling program coverage introduces odd runtime dependencies
-- between components.
cuz_coverage
| fromFlagOrDefault False (packageConfigCoverage localPackagesConfig) =
cuz "program coverage is enabled"
| otherwise = []

-- \| Sometimes a package may make use of features which are only
-- supported in per-package mode. If this is the case, we should
Expand Down
18 changes: 18 additions & 0 deletions cabal-testsuite/PackageTests/Regression/T4798/T4798.cabal
@@ -0,0 +1,18 @@
cabal-version: >=1.10
name: T4798
version: 0.1

library
exposed-modules: U2F, U2F.Types
ghc-options: -Wall
build-depends: base
hs-source-dirs: src
default-language: Haskell2010

test-suite hspec-suite
type: exitcode-stdio-1.0
main-is: test.hs
ghc-options: -Wall
hs-source-dirs: tests
default-language: Haskell2010
build-depends: base, T4798
@@ -0,0 +1 @@
packages: .
3 changes: 3 additions & 0 deletions cabal-testsuite/PackageTests/Regression/T4798/cabal.test.hs
@@ -0,0 +1,3 @@
import Test.Cabal.Prelude
main = cabalTest $ cabal "test" ["--enable-coverage"]

6 changes: 6 additions & 0 deletions cabal-testsuite/PackageTests/Regression/T4798/src/U2F.hs
@@ -0,0 +1,6 @@
module U2F where

import U2F.Types

ourCurve :: String
ourCurve = "SEC_p256r1"
@@ -0,0 +1,3 @@
module UF2.Types where

data U2FError = RegistrationParseError
6 changes: 6 additions & 0 deletions cabal-testsuite/PackageTests/Regression/T4798/tests/test.hs
@@ -0,0 +1,6 @@
import U2F
import U2F.Types

main = print ourCurve
main :: IO ()

0 comments on commit aef4e35

Please sign in to comment.