diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index 18fbcf549af..bb3aca57258 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -41,7 +41,7 @@ md5CheckGenericPackageDescription proxy = md5Check proxy md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion md5CheckLocalBuildInfo proxy = md5Check proxy #if MIN_VERSION_base(4,19,0) - 0x205fbe2649bc5e488bce50c07a71cadb + 0x512e880894570552f08aa82547568dbc #else - 0x26e91a71ebd19d4d6ce37f798ede249a + 0x968807984ad42d41a9e9ab696a9fec58 #endif diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index b7aabf65f18..4b61b2d15df 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} @@ -44,6 +46,7 @@ module Distribution.Simple.Configure , localBuildInfoFile , getInstalledPackages , getInstalledPackagesMonitorFiles + , getInstalledPackagesById , getPackageDBContents , configCompilerEx , configCompilerAuxEx @@ -56,6 +59,7 @@ module Distribution.Simple.Configure , platformDefines ) where +import Control.Monad import Distribution.Compat.Prelude import Prelude () @@ -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 @@ -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 @@ -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 @@ -1747,6 +1763,18 @@ 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 :: Verbosity -> LocalBuildInfo -> [UnitId] -> IO [InstalledPackageInfo] +getInstalledPackagesById verbosity LocalBuildInfo{compiler, withPackageDB, withPrograms} unitids = do + ipindex <- getInstalledPackages verbosity compiler withPackageDB withPrograms + mapM + ( \uid -> case lookupUnitId ipindex uid of + Nothing -> dieWithException verbosity (MissingCoveredInstalledLibrary 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 diff --git a/Cabal/src/Distribution/Simple/Errors.hs b/Cabal/src/Distribution/Simple/Errors.hs index dc3e30ab9b6..14130b349de 100644 --- a/Cabal/src/Distribution/Simple/Errors.hs +++ b/Cabal/src/Distribution/Simple/Errors.hs @@ -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 @@ -301,6 +302,7 @@ exceptionCode e = case e of NoProgramFound{} -> 7620 BadVersionDb{} -> 8038 UnknownVersionDb{} -> 1008 + MissingCoveredInstalledLibrary{} -> 9341 versionRequirement :: VersionRange -> String versionRequirement range @@ -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." diff --git a/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs b/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs index 16bd94294ee..7ff326aa9b3 100644 --- a/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs +++ b/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs @@ -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 @@ -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 @@ -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 + | isCoverageEnabled = toFlag $ Hpc.mixDir (tmpDir extraCompilationArtifacts) way | otherwise = mempty rpaths <- getRPaths lbi clbi diff --git a/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs b/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs index bfb9ddfa09c..8ae87642b51 100644 --- a/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs +++ b/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs @@ -9,7 +9,6 @@ import Distribution.Package import Distribution.PackageDescription as PD import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler -import Distribution.Simple.Flag (Flag (..), fromFlag, toFlag) import Distribution.Simple.GHC.Build ( checkNeedsRecompilation , componentGhcOptions @@ -27,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 @@ -96,10 +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 - distPref = fromFlag $ configDistPref $ configFlags lbi hpcdir way | forRepl = mempty -- HPC is not supported in ghci - | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way + | isCoverageEnabled = toFlag $ Hpc.mixDir (libTargetDir extraCompilationArtifacts) way | otherwise = mempty createDirectoryIfMissingVerbose verbosity True libTargetDir diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index 1c4d899812d..53f78b7e5e6 100644 --- a/Cabal/src/Distribution/Simple/GHCJS.hs +++ b/Cabal/src/Distribution/Simple/GHCJS.hs @@ -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 @@ -515,10 +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 - distPref = fromFlag $ configDistPref $ configFlags lbi hpcdir way | forRepl = mempty -- HPC is not supported in ghci - | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way + | isCoverageEnabled = toFlag $ Hpc.mixDir (libTargetDir extraCompilationArtifacts) way | otherwise = mempty createDirectoryIfMissingVerbose verbosity True libTargetDir @@ -1235,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 + | isCoverageEnabled = toFlag $ Hpc.mixDir (tmpDir extraCompilationArtifacts) way | otherwise = mempty rpaths <- getRPaths lbi clbi diff --git a/Cabal/src/Distribution/Simple/Hpc.hs b/Cabal/src/Distribution/Simple/Hpc.hs index e39b75d4ae4..158051b0924 100644 --- a/Cabal/src/Distribution/Simple/Hpc.hs +++ b/Cabal/src/Distribution/Simple/Hpc.hs @@ -22,27 +22,26 @@ module Distribution.Simple.Hpc , mixDir , tixDir , tixFilePath + , HPCMarkupInfo (..) , markupPackage ) where import Distribution.Compat.Prelude import Prelude () -import Distribution.ModuleName (main) +import Distribution.ModuleName (ModuleName, main) import Distribution.PackageDescription ( TestSuite (..) , testModules ) import qualified Distribution.PackageDescription as PD import Distribution.Pretty -import Distribution.Simple.Flag (fromFlagOrDefault) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo (..)) import Distribution.Simple.Program ( hpcProgram , requireProgramVersion ) import Distribution.Simple.Program.Hpc (markup, union) -import Distribution.Simple.Setup (TestFlags (..)) import Distribution.Simple.Utils (notice) import Distribution.Types.UnqualComponentName import Distribution.Verbosity (Verbosity ()) @@ -112,17 +111,27 @@ guessWay lbi | withDynExe lbi = Dyn | otherwise = Vanilla +-- | Haskell Program Coverage information required to produce a valid HPC +-- report through the `hpc markup` call for the package libraries. +data HPCMarkupInfo = HPCMarkupInfo + { pathsToLibsArtifacts :: [FilePath] + -- ^ The paths to the library components whose modules are included in the + -- coverage report + , libsModulesToInclude :: [ModuleName] + -- ^ The modules to include in the coverage report + } + -- | Generate the HTML markup for a package's test suites. markupPackage :: Verbosity - -> TestFlags + -> HPCMarkupInfo -> LocalBuildInfo -> FilePath -- ^ Testsuite \"dist/\" prefix -> PD.PackageDescription -> [TestSuite] -> IO () -markupPackage verbosity TestFlags{testCoverageDistPrefs, testCoverageLibsModules} lbi testDistPref pkg_descr suites = do +markupPackage verbosity HPCMarkupInfo{pathsToLibsArtifacts, libsModulesToInclude} lbi testDistPref pkg_descr suites = do let tixFiles = map (tixFilePath testDistPref way) testNames tixFilesExist <- traverse doesFileExist tixFiles when (and tixFilesExist) $ do @@ -160,7 +169,7 @@ markupPackage verbosity TestFlags{testCoverageDistPrefs, testCoverageLibsModules union hpc verbosity tixFiles summedTixFile excluded return summedTixFile - markup hpc hpcVer verbosity tixFile mixDirs htmlDir' included + markup hpc hpcVer verbosity tixFile mixDirs htmlDir' libsModulesToInclude notice verbosity $ "Package coverage report written to " ++ htmlDir' @@ -168,5 +177,4 @@ markupPackage verbosity TestFlags{testCoverageDistPrefs, testCoverageLibsModules where way = guessWay lbi testNames = fmap (unUnqualComponentName . testName) suites - mixDirs = map (`mixDir` way) (fromFlagOrDefault [] testCoverageDistPrefs) - included = fromFlagOrDefault [] testCoverageLibsModules + mixDirs = map (`mixDir` way) pathsToLibsArtifacts diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index 05fd07f33ca..c2af17b8f9e 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -54,6 +54,7 @@ import Distribution.Types.DumpBuildInfo import Distribution.Types.GivenComponent import Distribution.Types.Module import Distribution.Types.PackageVersionConstraint +import Distribution.Types.UnitId import Distribution.Utils.NubList import Distribution.Verbosity import qualified Text.PrettyPrint as Disp @@ -220,6 +221,11 @@ data ConfigFlags = ConfigFlags -- ^ Allow depending on private sublibraries. This is used by external -- tools (like cabal-install) so they can add multiple-public-libraries -- compatibility to older ghcs by checking visibility externally. + , configCoverageFor :: Flag [UnitId] + -- ^ The list of libraries to be included in the hpc coverage report for + -- testsuites run with @--enable-coverage@. Notably, this list must exclude + -- indefinite libraries and instantiations because HPC does not support + -- backpack (Nov. 2023). } deriving (Generic, Read, Show, Typeable) @@ -288,6 +294,7 @@ instance Eq ConfigFlags where && equal configDebugInfo && equal configDumpBuildInfo && equal configUseResponseFiles + && equal configCoverageFor where equal f = on (==) f a b @@ -828,6 +835,22 @@ configureOptions showOrParseArgs = configAllowDependingOnPrivateLibs (\v flags -> flags{configAllowDependingOnPrivateLibs = v}) trueArg + , option + "" + ["coverage-for"] + "A list of unit-ids of libraries to include in the Haskell Program Coverage report." + configCoverageFor + ( \v flags -> + flags + { configCoverageFor = + mergeListFlag (configCoverageFor flags) v + } + ) + ( reqArg' + "UNITID" + (Flag . (: []) . fromString) + (fmap prettyShow . fromFlagOrDefault []) + ) ] where liftInstallDirs = diff --git a/Cabal/src/Distribution/Simple/Setup/Test.hs b/Cabal/src/Distribution/Simple/Setup/Test.hs index c2fa3f14d6d..bee0ccbef1a 100644 --- a/Cabal/src/Distribution/Simple/Setup/Test.hs +++ b/Cabal/src/Distribution/Simple/Setup/Test.hs @@ -40,7 +40,6 @@ import Distribution.Simple.Utils import Distribution.Verbosity import qualified Text.PrettyPrint as Disp -import Distribution.ModuleName (ModuleName) import Distribution.Simple.Setup.Common -- ------------------------------------------------------------ @@ -89,15 +88,6 @@ data TestFlags = TestFlags , testKeepTix :: Flag Bool , testWrapper :: Flag FilePath , testFailWhenNoTestSuites :: Flag Bool - , testCoverageLibsModules :: Flag [ModuleName] - -- ^ The list of all modules from libraries in the local project that should - -- be included in the hpc coverage report. - , testCoverageDistPrefs :: Flag [FilePath] - -- ^ The path to each library local to this project and to the test - -- components being built, to include in coverage reporting (notably, this - -- excludes indefinite libraries and instantiations because HPC does not - -- support backpack - Nov. 2023). Cabal uses these paths as dist prefixes to - -- determine the path to the `mix` dirs of each component to cover. , -- TODO: think about if/how options are passed to test exes testOptions :: [PathTemplate] } @@ -114,8 +104,6 @@ defaultTestFlags = , testKeepTix = toFlag False , testWrapper = NoFlag , testFailWhenNoTestSuites = toFlag False - , testCoverageLibsModules = NoFlag - , testCoverageDistPrefs = NoFlag , testOptions = [] } @@ -221,38 +209,6 @@ testOptions' showOrParseArgs = testFailWhenNoTestSuites (\v flags -> flags{testFailWhenNoTestSuites = v}) trueArg - , option - [] - ["coverage-module"] - "Module of a project-local library to include in the HPC report" - testCoverageLibsModules - ( \v flags -> - flags - { testCoverageLibsModules = - mergeListFlag (testCoverageLibsModules flags) v - } - ) - ( reqArg' - "MODULE" - (Flag . (: []) . fromString) - (fmap prettyShow . fromFlagOrDefault []) - ) - , option - [] - ["coverage-dist-dir"] - "The directory where Cabal puts generated build files of an HPC enabled component" - testCoverageDistPrefs - ( \v flags -> - flags - { testCoverageDistPrefs = - mergeListFlag (testCoverageDistPrefs flags) v - } - ) - ( reqArg' - "DIR" - (Flag . (: [])) - (fromFlagOrDefault []) - ) , option [] ["test-options"] diff --git a/Cabal/src/Distribution/Simple/Test.hs b/Cabal/src/Distribution/Simple/Test.hs index 62158ece57f..e0fd4b65e4e 100644 --- a/Cabal/src/Distribution/Simple/Test.hs +++ b/Cabal/src/Distribution/Simple/Test.hs @@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- @@ -38,7 +40,15 @@ import Distribution.TestSuite import qualified Distribution.Types.LocalBuildInfo as LBI import Distribution.Types.UnqualComponentName +import Distribution.Simple.Configure (getInstalledPackagesById) import Distribution.Simple.Errors +import Distribution.Simple.Register +import Distribution.Simple.Setup (fromFlagOrDefault) +import Distribution.Simple.Setup.Common (extraCompilationArtifacts) +import Distribution.Simple.Setup.Config +import Distribution.Types.ExposedModule +import Distribution.Types.InstalledPackageInfo (InstalledPackageInfo (libraryDirs), exposedModules) +import Distribution.Types.LocalBuildInfo (LocalBuildInfo (..)) import System.Directory ( createDirectoryIfMissing , doesFileExist @@ -58,7 +68,7 @@ test -> TestFlags -- ^ flags sent to test -> IO () -test args pkg_descr lbi flags = do +test args pkg_descr lbi0 flags = do let verbosity = fromFlag $ testVerbosity flags machineTemplate = fromFlag $ testMachineLog flags distPref = fromFlag $ testDistPref flags @@ -66,18 +76,23 @@ test args pkg_descr lbi flags = do testNames = args pkgTests = PD.testSuites pkg_descr enabledTests = LBI.enabledTestLBIs pkg_descr lbi + -- We must add the internalPkgDB to the package database stack to lookup + -- the path to HPC dirs of libraries local to this package + internalPkgDB = internalPackageDBPath lbi distPref + lbi = lbi0{withPackageDB = withPackageDB lbi0 ++ [SpecificPackageDB internalPkgDB]} doTest - :: ( (PD.TestSuite, LBI.ComponentLocalBuildInfo) + :: HPCMarkupInfo + -> ( (PD.TestSuite, LBI.ComponentLocalBuildInfo) , Maybe TestSuiteLog ) -> IO TestSuiteLog - doTest ((suite, clbi), _) = + doTest hpcMarkupInfo ((suite, clbi), _) = case PD.testInterface suite of PD.TestSuiteExeV10 _ _ -> - ExeV10.runTest pkg_descr lbi clbi flags suite + ExeV10.runTest pkg_descr lbi clbi hpcMarkupInfo flags suite PD.TestSuiteLibV09 _ _ -> - LibV09.runTest pkg_descr lbi clbi flags suite + LibV09.runTest pkg_descr lbi clbi hpcMarkupInfo flags suite _ -> return TestSuiteLog @@ -122,9 +137,30 @@ test args pkg_descr lbi flags = do >>= filterM doesFileExist . map (testLogDir ) >>= traverse_ removeFile + -- We configured the unit-ids of libraries we should cover in our coverage + -- report at configure time into the local build info. At build time, we built + -- the hpc artifacts into the extraCompilationArtifacts directory, which, at + -- install time, is copied into the ghc-pkg database files. + -- Now, we get the path to the HPC artifacts and exposed modules of each + -- library by querying the package database keyed by unit-id: + let coverageFor = fromFlagOrDefault [] (configCoverageFor (configFlags lbi)) + ipkginfos <- getInstalledPackagesById verbosity lbi coverageFor + let ( concat -> pathsToLibsArtifacts + , concat -> libsModulesToInclude + ) = + unzip $ + map + ( \ip -> + ( map ( extraCompilationArtifacts) $ libraryDirs ip + , map exposedName $ exposedModules ip + ) + ) + ipkginfos + hpcMarkupInfo = HPCMarkupInfo{pathsToLibsArtifacts, libsModulesToInclude} + let totalSuites = length testsToRun notice verbosity $ "Running " ++ show totalSuites ++ " test suites..." - suites <- traverse doTest testsToRun + suites <- traverse (doTest hpcMarkupInfo) testsToRun let packageLog = (localPackageLog pkg_descr lbi){testSuites = suites} packageLogFile = () testLogDir $ @@ -133,7 +169,7 @@ test args pkg_descr lbi flags = do writeFile packageLogFile $ show packageLog when (LBI.testCoverage lbi) $ - markupPackage verbosity flags lbi distPref pkg_descr $ + markupPackage verbosity hpcMarkupInfo lbi distPref pkg_descr $ map (fst . fst) testsToRun unless allOk exitFailure diff --git a/Cabal/src/Distribution/Simple/Test/ExeV10.hs b/Cabal/src/Distribution/Simple/Test/ExeV10.hs index af734c5123e..0cf2ec3d12a 100644 --- a/Cabal/src/Distribution/Simple/Test/ExeV10.hs +++ b/Cabal/src/Distribution/Simple/Test/ExeV10.hs @@ -44,10 +44,11 @@ runTest :: PD.PackageDescription -> LBI.LocalBuildInfo -> LBI.ComponentLocalBuildInfo + -> HPCMarkupInfo -> TestFlags -> PD.TestSuite -> IO TestSuiteLog -runTest pkg_descr lbi clbi flags suite = do +runTest pkg_descr lbi clbi hpcMarkupInfo flags suite = do let isCoverageEnabled = LBI.testCoverage lbi way = guessWay lbi tixDir_ = tixDir distPref way @@ -178,7 +179,7 @@ runTest pkg_descr lbi clbi flags suite = do when (null $ PD.allLibraries pkg_descr) $ dieWithException verbosity TestCoverageSupport - markupPackage verbosity flags lbi distPref pkg_descr [suite] + markupPackage verbosity hpcMarkupInfo lbi distPref pkg_descr [suite] return suiteLog where diff --git a/Cabal/src/Distribution/Simple/Test/LibV09.hs b/Cabal/src/Distribution/Simple/Test/LibV09.hs index 3204ce12227..f5a6ec2ce18 100644 --- a/Cabal/src/Distribution/Simple/Test/LibV09.hs +++ b/Cabal/src/Distribution/Simple/Test/LibV09.hs @@ -58,10 +58,11 @@ runTest :: PD.PackageDescription -> LBI.LocalBuildInfo -> LBI.ComponentLocalBuildInfo + -> HPCMarkupInfo -> TestFlags -> PD.TestSuite -> IO TestSuiteLog -runTest pkg_descr lbi clbi flags suite = do +runTest pkg_descr lbi clbi hpcMarkupInfo flags suite = do let isCoverageEnabled = LBI.testCoverage lbi way = guessWay lbi @@ -194,7 +195,7 @@ runTest pkg_descr lbi clbi flags suite = do when (null $ PD.allLibraries pkg_descr) $ dieWithException verbosity TestCoverageSupport - markupPackage verbosity flags lbi distPref pkg_descr [suite] + markupPackage verbosity hpcMarkupInfo lbi distPref pkg_descr [suite] return suiteLog where diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index feaf10a6360..0fe93081bd7 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -531,6 +531,7 @@ instance Semigroup SavedConfig where , configDumpBuildInfo = combine configDumpBuildInfo , configAllowDependingOnPrivateLibs = combine configAllowDependingOnPrivateLibs + , configCoverageFor = combine configCoverageFor } where combine = combine' savedConfigureFlags @@ -636,8 +637,6 @@ instance Semigroup SavedConfig where , testKeepTix = combine testKeepTix , testWrapper = combine testWrapper , testFailWhenNoTestSuites = combine testFailWhenNoTestSuites - , testCoverageLibsModules = combine testCoverageLibsModules - , testCoverageDistPrefs = combine testCoverageDistPrefs , testOptions = lastNonEmpty testOptions } where diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs index 1b00113d8e7..3a2ce95de0a 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs @@ -1099,7 +1099,7 @@ unpackPackageTarball verbosity tarball parentdir pkgid pkgTextOverride = parentdir pkgsubdir prettyShow pkgname - <.> "cabal" + <.> "cabal" pkgsubdir = prettyShow pkgid pkgname = packageName pkgid @@ -1356,6 +1356,7 @@ buildAndInstallUnpackedPackage configureFlags v = flip filterConfigureFlags v $ setupHsConfigureFlags + plan rpkg pkgshared verbosity @@ -1714,6 +1715,7 @@ buildInplaceUnpackedPackage configureFlags v = flip filterConfigureFlags v $ setupHsConfigureFlags + plan rpkg pkgshared verbosity @@ -1734,11 +1736,8 @@ buildInplaceUnpackedPackage testFlags v = flip filterTestFlags v $ setupHsTestFlags - plan pkg - pkgshared verbosity - distDirLayout builddir testArgs _ = setupHsTestArgs pkg diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 1ddff54b7f7..d949437f5d6 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -727,6 +727,7 @@ convertLegacyPerPackageFlags , configDebugInfo = packageConfigDebugInfo , configDumpBuildInfo = packageConfigDumpBuildInfo , configRelocatable = packageConfigRelocatable + , configCoverageFor = _ } = configFlags packageConfigProgramPaths = MapLast (Map.fromList configProgramPaths) packageConfigProgramArgs = MapMappend (Map.fromListWith (++) configProgramArgs) @@ -767,8 +768,6 @@ convertLegacyPerPackageFlags , testKeepTix = packageConfigTestKeepTix , testWrapper = packageConfigTestWrapper , testFailWhenNoTestSuites = packageConfigTestFailWhenNoTestSuites - , testCoverageLibsModules = _ - , testCoverageDistPrefs = _ , testOptions = packageConfigTestTestOptions } = testFlags @@ -1039,6 +1038,7 @@ convertToLegacyAllPackageConfig , configUseResponseFiles = mempty , configDumpBuildInfo = mempty , configAllowDependingOnPrivateLibs = mempty + , configCoverageFor = mempty } haddockFlags = @@ -1115,6 +1115,7 @@ convertToLegacyPerPackageConfig PackageConfig{..} = , configUseResponseFiles = mempty , configDumpBuildInfo = packageConfigDumpBuildInfo , configAllowDependingOnPrivateLibs = mempty + , configCoverageFor = mempty } installFlags = @@ -1162,8 +1163,6 @@ convertToLegacyPerPackageConfig PackageConfig{..} = , testKeepTix = packageConfigTestKeepTix , testWrapper = packageConfigTestWrapper , testFailWhenNoTestSuites = packageConfigTestFailWhenNoTestSuites - , testCoverageLibsModules = mempty - , testCoverageDistPrefs = mempty , testOptions = packageConfigTestTestOptions } diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index 5d9c5e9fef1..a13d35011b1 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -1040,6 +1040,7 @@ printPlan showConfigureFlags elab = let fullConfigureFlags = setupHsConfigureFlags + elaboratedPlan (ReadyPackage elab) elaboratedShared verbosity diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 4417b1eef24..caa022abd67 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -149,7 +149,6 @@ import Distribution.Simple.Program.Db import Distribution.Simple.Program.Find import Distribution.Simple.Setup ( Flag (..) - , TestFlags (testCoverageDistPrefs) , flagToList , flagToMaybe , fromFlagOrDefault @@ -1726,7 +1725,7 @@ elaborateInstallPlan dieProgress $ text "Internal libraries only supported with per-component builds." $$ text "Per-component builds were disabled because" - <+> fsep (punctuate comma reasons) + <+> fsep (punctuate comma reasons) -- TODO: Maybe exclude Backpack too elab0 = elaborateSolverToCommon spkg @@ -4085,12 +4084,14 @@ computeInstallDirs storeDirLayout defaultInstallDirs elaboratedShared elab -- make the various Setup.hs {configure,build,copy} flags setupHsConfigureFlags - :: ElaboratedReadyPackage + :: ElaboratedInstallPlan + -> ElaboratedReadyPackage -> ElaboratedSharedConfig -> Verbosity -> FilePath -> Cabal.ConfigFlags setupHsConfigureFlags + plan (ReadyPackage elab@ElaboratedConfiguredPackage{..}) sharedConfig@ElaboratedSharedConfig{..} verbosity @@ -4236,6 +4237,8 @@ setupHsConfigureFlags Just _ -> error "non-library dependency" Nothing -> LMainLibName + configCoverageFor = determineCoverageFor elabPkgSourceId plan + setupHsConfigureArgs :: ElaboratedConfiguredPackage -> [String] @@ -4282,14 +4285,11 @@ setupHsBuildArgs (ElaboratedConfiguredPackage{elabPkgOrComp = ElabComponent _}) [] setupHsTestFlags - :: ElaboratedInstallPlan - -> ElaboratedConfiguredPackage - -> ElaboratedSharedConfig + :: ElaboratedConfiguredPackage -> Verbosity - -> DistDirLayout -> FilePath -> Cabal.TestFlags -setupHsTestFlags plan (ElaboratedConfiguredPackage{..}) sharedConfig verbosity distDirLayout builddir = +setupHsTestFlags (ElaboratedConfiguredPackage{..}) verbosity builddir = Cabal.TestFlags { testDistPref = toFlag builddir , testVerbosity = toFlag verbosity @@ -4299,47 +4299,8 @@ setupHsTestFlags plan (ElaboratedConfiguredPackage{..}) sharedConfig verbosity d , testKeepTix = toFlag elabTestKeepTix , testWrapper = maybe mempty toFlag elabTestWrapper , testFailWhenNoTestSuites = toFlag elabTestFailWhenNoTestSuites - , testCoverageLibsModules = toFlag covIncludeModules - , testCoverageDistPrefs = toFlag covLibsDistPref , testOptions = elabTestTestOptions } - where - -- The path to dist dir of each of the libraries to consider in hpc, from which Cabal determines the path to the `mix` dir. - covLibsDistPref = map (distBuildDirectory distDirLayout . elabDistDirParams sharedConfig) librariesToCover - -- The list of modules from libraries to consider in hpc, that Cabal passes to the hpc markup call - -- This list includes all modules, not only the exposed ones. - covIncludeModules = concatMap (\ElaboratedConfiguredPackage{elabModuleShape = modShape} -> Map.keys $ modShapeProvides modShape) librariesToCover - - -- The list of non-pre-existing libraries without module holes, i.e. the - -- main library and sub-libraries components of all the local packages in - -- the project that do not require instantiations or are instantiations, - -- and the testsuite component. - -- - -- TODO: I think that if the packages it depends on are still uninstalled, - -- this seemingly includes the packages that are not local to the project?! - -- Weird, because we filter on localToProject! - -- Try it on cabal-install: cabal test --enable-coverage cabal-install - librariesToCover = - mapMaybe - ( \case - InstallPlan.Installed elab - | shouldCoverPkg elab -> Just elab - InstallPlan.Configured elab - | shouldCoverPkg elab -> Just elab - _ -> Nothing - ) - $ Graph.toList - $ InstallPlan.toGraph plan - - shouldCoverPkg ElaboratedConfiguredPackage{elabModuleShape = modShape, elabPkgSourceId = pkgId} = - elabLocalToProject - && not (isIndefiniteOrInstantiation modShape) - -- TODO(#9493): We can only cover libraries in the same package - -- as the testsuite - && pkgId == elabPkgSourceId - - isIndefiniteOrInstantiation :: ModuleShape -> Bool - isIndefiniteOrInstantiation = not . Set.null . modShapeRequires setupHsTestArgs :: ElaboratedConfiguredPackage -> [String] -- TODO: Does the issue #3335 affects test as well @@ -4681,3 +4642,37 @@ inplaceBinRoot inplaceBinRoot layout config package = distBuildDirectory layout (elabDistDirParams config package) "build" + +-------------------------------------------------------------------------------- +-- Configure --coverage-for flags + +-- The list of non-pre-existing libraries without module holes, i.e. the +-- main library and sub-libraries components of all the local packages in +-- the project that do not require instantiations or are instantiations. +determineCoverageFor + :: PackageId + -- ^ The 'PackageId' of the package or component being configured + -> ElaboratedInstallPlan + -> Flag [UnitId] +determineCoverageFor configuredPkgSourceId plan = + Flag + $ mapMaybe + ( \case + InstallPlan.Installed elab + | shouldCoverPkg elab -> Just $ elabUnitId elab + InstallPlan.Configured elab + | shouldCoverPkg elab -> Just $ elabUnitId elab + _ -> Nothing + ) + $ Graph.toList + $ InstallPlan.toGraph plan + where + shouldCoverPkg ElaboratedConfiguredPackage{elabModuleShape, elabPkgSourceId, elabLocalToProject} = + elabLocalToProject + && not (isIndefiniteOrInstantiation elabModuleShape) + -- TODO(#9493): We can only cover libraries in the same package + -- as the testsuite + && configuredPkgSourceId == elabPkgSourceId + + isIndefiniteOrInstantiation :: ModuleShape -> Bool + isIndefiniteOrInstantiation = not . Set.null . modShapeRequires diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 5489706ac8e..a5d91aaf19b 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -677,6 +677,11 @@ filterConfigureFlags flags cabalLibVersion -- We add a Cabal>=3.11 constraint before solving when multi-repl is -- enabled, so this should never trigger. configPromisedDependencies = assert (null $ configPromisedDependencies flags) [] + , -- Cabal < 3.11 does not understand '--coverage-for', which is OK + -- because previous versions of Cabal using coverage implied + -- whole-package builds (cuz_coverage), and determine the path to + -- libraries mix dirs from the testsuite root with a small hack. + configCoverageFor = NoFlag } flags_3_7_0 = @@ -1093,24 +1098,18 @@ filterTestFlags :: TestFlags -> Version -> TestFlags filterTestFlags flags cabalLibVersion -- NB: we expect the latest version to be the most common case, -- so test it first. - | cabalLibVersion >= mkVersion [3, 11, 0] = flags_latest + | cabalLibVersion >= mkVersion [3, 0, 0] = flags_latest -- The naming convention is that flags_version gives flags with -- all flags *introduced* in version eliminated. -- It is NOT the latest version of Cabal library that -- these flags work for; version of introduction is a more -- natural metric. - | cabalLibVersion < mkVersion [3, 11, 0] = flags_3_10_0 | cabalLibVersion < mkVersion [3, 0, 0] = flags_3_0_0 | otherwise = error "the impossible just happened" -- see first guard where flags_latest = flags - flags_3_10_0 = - flags_latest - { Cabal.testCoverageLibsModules = NoFlag - , Cabal.testCoverageDistPrefs = NoFlag - } flags_3_0_0 = - flags_3_10_0 + flags_latest { -- Cabal < 3.0 doesn't know about --test-wrapper Cabal.testWrapper = NoFlag } diff --git a/cabal-testsuite/PackageTests/CustomTestCoverage/A.hs b/cabal-testsuite/PackageTests/CustomTestCoverage/A.hs new file mode 100644 index 00000000000..e0ba50b355f --- /dev/null +++ b/cabal-testsuite/PackageTests/CustomTestCoverage/A.hs @@ -0,0 +1,3 @@ +module A where + +str = "A" diff --git a/cabal-testsuite/PackageTests/CustomTestCoverage/Setup.hs b/cabal-testsuite/PackageTests/CustomTestCoverage/Setup.hs new file mode 100644 index 00000000000..20b960ede90 --- /dev/null +++ b/cabal-testsuite/PackageTests/CustomTestCoverage/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +import System.IO +main = hPutStrLn stderr "ThisIsCustomYeah" >> defaultMain diff --git a/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.project b/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.test.hs b/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.test.hs new file mode 100644 index 00000000000..9f5a9c4895e --- /dev/null +++ b/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude +main = cabalTest $ do + -- implicit setup-depends conflict with GHC >= 8.2; c.f. #415 + skipUnlessGhcVersion "< 8.2" + cabal "test" ["--enable-coverage"] diff --git a/cabal-testsuite/PackageTests/CustomTestCoverage/plain.cabal b/cabal-testsuite/PackageTests/CustomTestCoverage/plain.cabal new file mode 100644 index 00000000000..6eaf31ae5fd --- /dev/null +++ b/cabal-testsuite/PackageTests/CustomTestCoverage/plain.cabal @@ -0,0 +1,22 @@ +cabal-version: 3.0 +name: plain +version: 0.1.0.0 +license: BSD-3-Clause +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Custom + +custom-setup + setup-depends: + base, Cabal + +library + exposed-modules: A + build-depends: base + default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Test.hs + build-depends: base, plain diff --git a/cabal-testsuite/PackageTests/CustomTestCoverage/setup.test.hs b/cabal-testsuite/PackageTests/CustomTestCoverage/setup.test.hs new file mode 100644 index 00000000000..ab57cd6b08c --- /dev/null +++ b/cabal-testsuite/PackageTests/CustomTestCoverage/setup.test.hs @@ -0,0 +1,6 @@ +import Test.Cabal.Prelude +main = setupTest $ do + skipUnless "no Cabal for GHC" =<< hasCabalForGhc + setup' "configure" ["--enable-tests", "--enable-coverage"] >>= assertOutputContains "ThisIsCustomYeah" + setup' "build" [] >>= assertOutputContains "ThisIsCustomYeah" + setup' "test" [] >>= assertOutputContains "ThisIsCustomYeah" diff --git a/cabal-testsuite/PackageTests/CustomTestCoverage/test/Test.hs b/cabal-testsuite/PackageTests/CustomTestCoverage/test/Test.hs new file mode 100644 index 00000000000..80881436d49 --- /dev/null +++ b/cabal-testsuite/PackageTests/CustomTestCoverage/test/Test.hs @@ -0,0 +1,2 @@ +import A +main = print str