Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Allow per-component builds with coverage enabled #9464

Merged
merged 2 commits into from
Dec 18, 2023
Merged

Allow per-component builds with coverage enabled #9464

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
073ccc8
Per-component multi-package builds with coverage enabled
alt-romes Nov 22, 2023
d6e3804
HPC artifacts are written and read from pkg-db
alt-romes Dec 5, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ md5CheckGenericPackageDescription proxy = md5Check proxy
md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion
md5CheckLocalBuildInfo proxy = md5Check proxy
#if MIN_VERSION_base(4,19,0)
0x23942cff98237dc167ef90d64d7ef893
0x023b3cd1665b2acdedf72d231c96336b
#else
0xa4e9f8a7e1583906880d6ec2d1bbb14b
0xc6c0cc122cc60ce7943764cbaaacdc2d
#endif
42 changes: 40 additions & 2 deletions Cabal/src/Distribution/Simple/Configure.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
Expand Down Expand Up @@ -44,6 +46,7 @@ module Distribution.Simple.Configure
, localBuildInfoFile
, getInstalledPackages
, getInstalledPackagesMonitorFiles
, getInstalledPackagesById
, getPackageDBContents
, configCompilerEx
, configCompilerAuxEx
Expand All @@ -56,6 +59,7 @@ module Distribution.Simple.Configure
, platformDefines
) where

import Control.Monad
import Distribution.Compat.Prelude
import Prelude ()

Expand All @@ -78,7 +82,7 @@ import Distribution.Simple.BuildTarget
import Distribution.Simple.BuildToolDepends
import Distribution.Simple.Compiler
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.Simple.PackageIndex (InstalledPackageIndex, lookupUnitId)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PreProcess
import Distribution.Simple.Program
Expand Down Expand Up @@ -162,6 +166,7 @@ import qualified Data.Maybe as M
import qualified Data.Set as Set
import qualified Distribution.Compat.NonEmptySet as NES
import Distribution.Simple.Errors
import Distribution.Simple.Flag (mergeListFlag)
import Distribution.Types.AnnotatedId

type UseExternalInternalDeps = Bool
Expand Down Expand Up @@ -877,10 +882,21 @@ configure (pkg_descr0, pbi) cfg = do
Map.empty
buildComponents

-- For whole-package configure, we have to determine the additional
-- configCoverageFor of the main lib and sub libs here.
let extraCoverageFor :: [UnitId] = case enabled of
-- Whole package configure, add package libs
ComponentRequestedSpec{} -> mapMaybe (\case LibComponentLocalBuildInfo{componentUnitId} -> Just componentUnitId; _ -> Nothing) buildComponents
-- Component configure, no need to do anything
OneComponentRequestedSpec{} -> []

-- TODO: Should we also enforce something here on that --coverage-for cannot
-- include indefinite components or instantiations?

let lbi =
(setCoverageLBI . setProfLBI)
LocalBuildInfo
{ configFlags = cfg
{ configFlags = cfg{configCoverageFor = mergeListFlag (configCoverageFor cfg) (toFlag extraCoverageFor)}
, flagAssignment = flags
, componentEnabledSpec = enabled
, extraConfigArgs = [] -- Currently configure does not
Expand Down Expand Up @@ -1747,6 +1763,28 @@ getInstalledPackagesMonitorFiles verbosity comp packageDBs progdb platform =
++ prettyShow other
return []

-- | Looks up the 'InstalledPackageInfo' of the given 'UnitId's from the
-- 'PackageDBStack' in the 'LocalBuildInfo'.
getInstalledPackagesById
:: (Exception (VerboseException exception), Show exception, Typeable exception)
=> Verbosity
-> LocalBuildInfo
-> (UnitId -> exception)
-- ^ Construct an exception that is thrown if a
-- unit-id is not found in the installed packages,
-- from the unit-id that is missing.
-> [UnitId]
-- ^ The unit ids to lookup in the installed packages
-> IO [InstalledPackageInfo]
getInstalledPackagesById verbosity LocalBuildInfo{compiler, withPackageDB, withPrograms} mkException unitids = do
ipindex <- getInstalledPackages verbosity compiler withPackageDB withPrograms
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This this function going to repeat this work for each package?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Right, 🤦

mapM
( \uid -> case lookupUnitId ipindex uid of
Nothing -> dieWithException verbosity (mkException uid)
Just ipkg -> return ipkg
)
unitids

-- | The user interface specifies the package dbs to use with a combination of
-- @--global@, @--user@ and @--package-db=global|user|clear|$file@.
-- This function combines the global/user flag and interprets the package-db
Expand Down
6 changes: 6 additions & 0 deletions Cabal/src/Distribution/Simple/Errors.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -170,6 +170,7 @@ data CabalException
| NoProgramFound String VersionRange
| BadVersionDb String Version VersionRange FilePath
| UnknownVersionDb String VersionRange FilePath
| MissingCoveredInstalledLibrary UnitId
deriving (Show, Typeable)

exceptionCode :: CabalException -> Int
Expand Down Expand Up @@ -301,6 +302,7 @@ exceptionCode e = case e of
NoProgramFound{} -> 7620
BadVersionDb{} -> 8038
UnknownVersionDb{} -> 1008
MissingCoveredInstalledLibrary{} -> 9341

versionRequirement :: VersionRange -> String
versionRequirement range
Expand Down Expand Up @@ -791,3 +793,7 @@ exceptionMessage e = case e of
++ " is required but the version of "
++ locationPath
++ " could not be determined."
MissingCoveredInstalledLibrary unitId ->
"Failed to find the installed unit '"
++ prettyShow unitId
++ "' in package database stack."
6 changes: 6 additions & 0 deletions Cabal/src/Distribution/Simple/Flag.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,7 @@ module Distribution.Simple.Flag
, flagToMaybe
, flagToList
, maybeToFlag
, mergeListFlag
, BooleanFlag (..)
) where

Expand Down Expand Up @@ -143,6 +144,11 @@ maybeToFlag :: Maybe a -> Flag a
maybeToFlag Nothing = NoFlag
maybeToFlag (Just x) = Flag x

-- | Merge the elements of a list 'Flag' with another list 'Flag'.
mergeListFlag :: Flag [a] -> Flag [a] -> Flag [a]
mergeListFlag currentFlags v =
Flag $ concat (flagToList currentFlags ++ flagToList v)

-- | Types that represent boolean flags.
class BooleanFlag a where
asBool :: a -> Bool
Expand Down
6 changes: 2 additions & 4 deletions Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,6 @@ import Distribution.PackageDescription.Utils (cabalBug)
import Distribution.Pretty
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
import Distribution.Simple.Flag (Flag (..), fromFlag, toFlag)
import Distribution.Simple.GHC.Build
( checkNeedsRecompilation
, componentGhcOptions
Expand All @@ -39,7 +38,7 @@ import Distribution.Simple.LocalBuildInfo
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Program
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup.Config
import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Repl
import Distribution.Simple.Utils
import Distribution.System
Expand Down Expand Up @@ -399,10 +398,9 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = exeCoverage lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| gbuildIsRepl bm = mempty -- HPC is not supported in ghci
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way (gbuildName bm)
| isCoverageEnabled = toFlag $ Hpc.mixDir (tmpDir </> extraCompilationArtifacts) way
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why is this tmpDir rather than say, buildDir?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is an artifact of buildGeneric vs buildOrRepl inconsistencies. In one place we have tmpDir and in the other buildDir. It is just a naming inconsistency between duplicated functions.

(Really, they call it tmpDir because the build dir is postfixed with -tmp in some situations like executables. Sam recently opened a ticket about this #9498)

| otherwise = mempty

rpaths <- getRPaths lbi clbi
Expand Down
12 changes: 2 additions & 10 deletions Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,8 @@ import Control.Monad (forM_)
import qualified Distribution.ModuleName as ModuleName
import Distribution.Package
import Distribution.PackageDescription as PD
import Distribution.Pretty
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
import Distribution.Simple.Flag (Flag (..), fromFlag, toFlag)
import Distribution.Simple.GHC.Build
( checkNeedsRecompilation
, componentGhcOptions
Expand All @@ -28,7 +26,7 @@ import Distribution.Simple.Program
import qualified Distribution.Simple.Program.Ar as Ar
import Distribution.Simple.Program.GHC
import qualified Distribution.Simple.Program.Ld as Ld
import Distribution.Simple.Setup.Config
import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Repl
import Distribution.Simple.Utils
import Distribution.System
Expand Down Expand Up @@ -97,15 +95,9 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = libCoverage lbi
-- TODO: Historically HPC files have been put into a directory which
-- has the package name. I'm going to avoid changing this for
-- now, but it would probably be better for this to be the
-- component ID instead...
pkg_name = prettyShow (PD.package pkg_descr)
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| forRepl = mempty -- HPC is not supported in ghci
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name
| isCoverageEnabled = toFlag $ Hpc.mixDir (libTargetDir </> extraCompilationArtifacts) way
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

and this is targetDir rather than buildDir or tmpDir.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Indeed, but this libTargetDir is where ultimately we should be placing the extra compilation artifacts, as it refers to the library build dir... target. In fact, neither buildDir nor tmpDir are in scope there...

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

There are a few naming inconsistencies amongst these functions

| otherwise = mempty

createDirectoryIfMissingVerbose verbosity True libTargetDir
Expand Down
15 changes: 4 additions & 11 deletions Cabal/src/Distribution/Simple/GHCJS.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -72,7 +72,7 @@ import Distribution.Simple.Program
import Distribution.Simple.Program.GHC
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Setup.Config
import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Types.ComponentLocalBuildInfo
Expand Down Expand Up @@ -481,7 +481,7 @@ buildOrReplLib
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
let uid = componentUnitId clbi
libTargetDir = componentBuildDir lbi clbi
whenVanillaLib forceVanilla =
Expand Down Expand Up @@ -515,15 +515,9 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = libCoverage lbi
-- TODO: Historically HPC files have been put into a directory which
-- has the package name. I'm going to avoid changing this for
-- now, but it would probably be better for this to be the
-- component ID instead...
pkg_name = prettyShow (PD.package pkg_descr)
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| forRepl = mempty -- HPC is not supported in ghci
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name
| isCoverageEnabled = toFlag $ Hpc.mixDir (libTargetDir </> extraCompilationArtifacts) way
| otherwise = mempty

createDirectoryIfMissingVerbose verbosity True libTargetDir
Expand Down Expand Up @@ -1240,10 +1234,9 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = exeCoverage lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| gbuildIsRepl bm = mempty -- HPC is not supported in ghci
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way (gbuildName bm)
| isCoverageEnabled = toFlag $ Hpc.mixDir (tmpDir </> extraCompilationArtifacts) way
| otherwise = mempty

rpaths <- getRPaths lbi clbi
Expand Down
Loading
Loading