diff --git a/Cabal/src/Distribution/Simple/Errors.hs b/Cabal/src/Distribution/Simple/Errors.hs index dc3e30ab9b6..c7a4d7765dd 100644 --- a/Cabal/src/Distribution/Simple/Errors.hs +++ b/Cabal/src/Distribution/Simple/Errors.hs @@ -715,12 +715,12 @@ exceptionMessage e = case e of "Could not find test program \"" ++ cmd ++ "\". Did you build the package first?" - TestCoverageSupport -> "Test coverage is only supported for packages with a library component." + TestCoverageSupport -> "Test coverage is only supported for projects with at least one (non-backpack) library component." Couldn'tFindTestProgLibV09 cmd -> "Could not find test program \"" ++ cmd ++ "\". Did you build the package first?" - TestCoverageSupportLibV09 -> "Test coverage is only supported for packages with a library component." + TestCoverageSupportLibV09 -> "Test coverage is only supported for projects with at least one (non-backpack) library component." RawSystemStdout errors -> errors FindFileCwd fileName -> fileName ++ " doesn't exist" FindFileEx fileName -> fileName ++ " doesn't exist" diff --git a/Cabal/src/Distribution/Simple/Flag.hs b/Cabal/src/Distribution/Simple/Flag.hs index 095fe7b9dde..e9e444457e6 100644 --- a/Cabal/src/Distribution/Simple/Flag.hs +++ b/Cabal/src/Distribution/Simple/Flag.hs @@ -29,6 +29,7 @@ module Distribution.Simple.Flag , flagToMaybe , flagToList , maybeToFlag + , mergeListFlag , BooleanFlag (..) ) where @@ -143,6 +144,12 @@ 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 diff --git a/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs b/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs index e4c4408b40b..16bd94294ee 100644 --- a/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs +++ b/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs @@ -402,7 +402,7 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do 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 distPref 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 9786470a990..9ed67320807 100644 --- a/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs +++ b/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs @@ -97,15 +97,10 @@ 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 distPref way | otherwise = mempty createDirectoryIfMissingVerbose verbosity True libTargetDir diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index c13afba220c..1c4d899812d 100644 --- a/Cabal/src/Distribution/Simple/GHCJS.hs +++ b/Cabal/src/Distribution/Simple/GHCJS.hs @@ -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 = @@ -515,15 +515,10 @@ 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 distPref way | otherwise = mempty createDirectoryIfMissingVerbose verbosity True libTargetDir @@ -1243,7 +1238,7 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do 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 distPref way | otherwise = mempty rpaths <- getRPaths lbi clbi diff --git a/Cabal/src/Distribution/Simple/Hpc.hs b/Cabal/src/Distribution/Simple/Hpc.hs index 5d24f190b7e..464bf01a2ad 100644 --- a/Cabal/src/Distribution/Simple/Hpc.hs +++ b/Cabal/src/Distribution/Simple/Hpc.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE NamedFieldPuns #-} ----------------------------------------------------------------------------- @@ -22,7 +23,6 @@ module Distribution.Simple.Hpc , tixDir , tixFilePath , markupPackage - , markupTest ) where import Distribution.Compat.Prelude @@ -30,8 +30,7 @@ import Prelude () import Distribution.ModuleName (main) import Distribution.PackageDescription - ( Library (..) - , TestSuite (..) + ( TestSuite (..) , testModules ) import qualified Distribution.PackageDescription as PD @@ -48,6 +47,8 @@ import Distribution.Verbosity (Verbosity ()) import Distribution.Version (anyVersion) import System.Directory (createDirectoryIfMissing, doesFileExist) import System.FilePath +import Distribution.Simple.Setup (TestFlags(..)) +import Distribution.Simple.Flag (fromFlagOrDefault) -- ------------------------------------------------------------------------- -- Haskell Program Coverage @@ -73,44 +74,16 @@ mixDir -- ^ \"dist/\" prefix -> Way -> FilePath - -- ^ 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 = hpcDir distPref way "mix" tixDir :: FilePath -- ^ \"dist/\" prefix -> Way -> FilePath - -- ^ Component name - -> FilePath -- ^ Directory containing test suite's .tix files -tixDir distPref way name = hpcDir distPref way "tix" name +tixDir distPref way = hpcDir distPref way "tix" -- | Path to the .tix file containing a test suite's sum statistics. tixFilePath @@ -121,17 +94,15 @@ tixFilePath -- ^ Component name -> FilePath -- ^ Path to test suite's .tix file -tixFilePath distPref way name = tixDir distPref way name name <.> "tix" +tixFilePath distPref way name = tixDir distPref way name <.> "tix" htmlDir :: FilePath -- ^ \"dist/\" prefix -> Way -> FilePath - -- ^ Component name - -> FilePath -- ^ Path to test suite's HTML markup directory -htmlDir distPref way name = hpcDir distPref way "html" name +htmlDir distPref way = hpcDir distPref way "html" -- | Attempt to guess the way the test suites in this package were compiled -- and linked with the library so the correct module interfaces are found. @@ -141,57 +112,18 @@ guessWay lbi | withDynExe lbi = Dyn | otherwise = Vanilla --- | Generate the HTML markup for a test suite. -markupTest - :: Verbosity - -> LocalBuildInfo - -> FilePath - -- ^ \"dist/\" prefix - -> String - -- ^ Library name - -> TestSuite - -> Library - -> IO () -markupTest verbosity lbi distPref libraryName suite library = do - tixFileExists <- doesFileExist $ tixFilePath distPref way $ testName' - when tixFileExists $ do - -- behaviour of 'markup' depends on version, so we need *a* version - -- but no particular one - (hpc, hpcVer, _) <- - requireProgramVersion - verbosity - hpcProgram - anyVersion - (withPrograms lbi) - let htmlDir_ = htmlDir distPref way testName' - markup - hpc - hpcVer - verbosity - (tixFilePath distPref way testName') - mixDirs - htmlDir_ - (exposedModules library) - notice verbosity $ - "Test coverage report written to " - ++ htmlDir_ - "hpc_index" <.> "html" - where - way = guessWay lbi - testName' = unUnqualComponentName $ testName suite - mixDirs = map (mixDir distPref way) [testName', libraryName] - --- | Generate the HTML markup for all of a package's test suites. +-- | Generate the HTML markup for a package's test suites. markupPackage :: Verbosity + -> TestFlags -> LocalBuildInfo -> FilePath - -- ^ \"dist/\" prefix + -- ^ Testsuite \"dist/\" prefix -> PD.PackageDescription -> [TestSuite] -> IO () -markupPackage verbosity lbi distPref pkg_descr suites = do - let tixFiles = map (tixFilePath distPref way) testNames +markupPackage verbosity TestFlags{testCoverageDistPrefs, testCoverageLibsModules} lbi testDistPref pkg_descr suites = do + let tixFiles = map (tixFilePath testDistPref way) testNames tixFilesExist <- traverse doesFileExist tixFiles when (and tixFilesExist) $ do -- behaviour of 'markup' depends on version, so we need *a* version @@ -202,12 +134,33 @@ markupPackage verbosity lbi distPref pkg_descr suites = do hpcProgram anyVersion (withPrograms lbi) - let outFile = tixFilePath distPref way libraryName - htmlDir' = htmlDir distPref way libraryName - excluded = concatMap testModules suites ++ [main] - createDirectoryIfMissing True $ takeDirectory outFile - union hpc verbosity tixFiles outFile excluded - markup hpc hpcVer verbosity outFile mixDirs htmlDir' included + let htmlDir' = htmlDir testDistPref way + -- The tix file used to generate the report is either the testsuite's + -- tix file, when there is only one testsuite, or the sum of the tix + -- files of all testsuites in the package, which gets put under pkgName + -- for this component (a bit weird) + -- TODO: cabal-install should pass to Cabal where to put the summed tix + -- and report, and perhaps even the testsuites from other packages in + -- the project which are currently not accounted for in the summed + -- report. + tixFile <- case suites of + -- We call 'markupPackage' once for each testsuite to run individually, + -- to get the coverage report of just the one testsuite + [oneTest] -> do + let testName' = unUnqualComponentName $ testName oneTest + return $ + tixFilePath testDistPref way testName' + -- And call 'markupPackage' once per `test` invocation with all the + -- testsuites to run, which results in multiple tix files being considered + _ -> do + let excluded = concatMap testModules suites ++ [main] + pkgName = prettyShow $ PD.package pkg_descr + summedTixFile = tixFilePath testDistPref way pkgName + createDirectoryIfMissing True $ takeDirectory summedTixFile + union hpc verbosity tixFiles summedTixFile excluded + return summedTixFile + + markup hpc hpcVer verbosity tixFile mixDirs htmlDir' included notice verbosity $ "Package coverage report written to " ++ htmlDir' @@ -215,6 +168,6 @@ markupPackage verbosity lbi distPref pkg_descr suites = do where way = guessWay lbi testNames = fmap (unUnqualComponentName . testName) suites - mixDirs = map (mixDir distPref way) $ libraryName : testNames - included = concatMap (exposedModules) $ PD.allLibraries pkg_descr - libraryName = prettyShow $ PD.package pkg_descr + mixDirs = map (`mixDir` way) (fromFlagOrDefault [] testCoverageDistPrefs) + included = fromFlagOrDefault [] testCoverageLibsModules + diff --git a/Cabal/src/Distribution/Simple/Setup/Test.hs b/Cabal/src/Distribution/Simple/Setup/Test.hs index bee0ccbef1a..0e5373f1b81 100644 --- a/Cabal/src/Distribution/Simple/Setup/Test.hs +++ b/Cabal/src/Distribution/Simple/Setup/Test.hs @@ -41,6 +41,7 @@ import Distribution.Verbosity import qualified Text.PrettyPrint as Disp import Distribution.Simple.Setup.Common +import Distribution.ModuleName (ModuleName) -- ------------------------------------------------------------ @@ -88,6 +89,16 @@ 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] } @@ -104,6 +115,8 @@ defaultTestFlags = , testKeepTix = toFlag False , testWrapper = NoFlag , testFailWhenNoTestSuites = toFlag False + , testCoverageLibsModules = NoFlag + , testCoverageDistPrefs = NoFlag , testOptions = [] } @@ -209,6 +222,36 @@ 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 7cb695cabaf..62158ece57f 100644 --- a/Cabal/src/Distribution/Simple/Test.hs +++ b/Cabal/src/Distribution/Simple/Test.hs @@ -133,7 +133,7 @@ test args pkg_descr lbi flags = do writeFile packageLogFile $ show packageLog when (LBI.testCoverage lbi) $ - markupPackage verbosity lbi distPref pkg_descr $ + markupPackage verbosity flags 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 04c7e30073a..9e439ae5b6a 100644 --- a/Cabal/src/Distribution/Simple/Test/ExeV10.hs +++ b/Cabal/src/Distribution/Simple/Test/ExeV10.hs @@ -10,7 +10,6 @@ import Prelude () import Distribution.Compat.Environment import qualified Distribution.PackageDescription as PD -import Distribution.Pretty import Distribution.Simple.Build.PathsModule import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler @@ -51,7 +50,7 @@ runTest runTest pkg_descr lbi clbi flags suite = do let isCoverageEnabled = LBI.testCoverage lbi way = guessWay lbi - tixDir_ = tixDir distPref way testName' + tixDir_ = tixDir distPref way pwd <- getCurrentDirectory existingEnv <- getEnvironment @@ -171,11 +170,9 @@ runTest pkg_descr lbi clbi flags suite = do notice verbosity $ summarizeSuiteFinish suiteLog when isCoverageEnabled $ - case PD.library pkg_descr of - Nothing -> - dieWithException verbosity TestCoverageSupport - Just library -> - markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite library + if null $ testCoverageDistPrefs flags + then dieWithException verbosity TestCoverageSupport + else markupPackage verbosity flags 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 b87897bfed7..b20a1458eec 100644 --- a/Cabal/src/Distribution/Simple/Test/LibV09.hs +++ b/Cabal/src/Distribution/Simple/Test/LibV09.hs @@ -80,12 +80,12 @@ runTest pkg_descr lbi clbi flags suite = do -- Remove old .tix files if appropriate. unless (fromFlag $ testKeepTix flags) $ do - let tDir = tixDir distPref way testName' + let tDir = tixDir distPref way exists' <- doesDirectoryExist tDir when exists' $ removeDirectoryRecursive tDir -- Create directory for HPC files. - createDirectoryIfMissing True $ tixDir distPref way testName' + createDirectoryIfMissing True $ tixDir distPref way -- Write summary notices indicating start of test suite notice verbosity $ summarizeSuiteStart testName' @@ -186,11 +186,9 @@ runTest pkg_descr lbi clbi flags suite = do notice verbosity $ summarizeSuiteFinish suiteLog when isCoverageEnabled $ - case PD.library pkg_descr of - Nothing -> - dieWithException verbosity TestCoverageSupportLibV09 - Just library -> - markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite library + if null $ testCoverageDistPrefs flags + then dieWithException verbosity TestCoverageSupportLibV09 + else markupPackage verbosity flags lbi distPref pkg_descr [suite] return suiteLog where diff --git a/Cabal/src/Distribution/Types/LocalBuildInfo.hs b/Cabal/src/Distribution/Types/LocalBuildInfo.hs index 116d5db264e..5d85b09aac5 100644 --- a/Cabal/src/Distribution/Types/LocalBuildInfo.hs +++ b/Cabal/src/Distribution/Types/LocalBuildInfo.hs @@ -108,6 +108,7 @@ data LocalBuildInfo = LocalBuildInfo , componentNameMap :: Map ComponentName [ComponentLocalBuildInfo] -- ^ A map from component name to all matching -- components. These coincide with 'componentGraph' + -- There may be more than one matching component because of backpack instantiations , promisedPkgs :: Map (PackageName, ComponentName) ComponentId -- ^ The packages we were promised, but aren't already installed. -- MP: Perhaps this just needs to be a Set UnitId at this stage. diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index 1a1fcfbb388..feaf10a6360 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -636,6 +636,8 @@ 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 e0c97aca924..1b00113d8e7 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs @@ -1734,9 +1734,11 @@ 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 7814d6ef0ca..1ddff54b7f7 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -767,6 +767,8 @@ convertLegacyPerPackageFlags , testKeepTix = packageConfigTestKeepTix , testWrapper = packageConfigTestWrapper , testFailWhenNoTestSuites = packageConfigTestFailWhenNoTestSuites + , testCoverageLibsModules = _ + , testCoverageDistPrefs = _ , testOptions = packageConfigTestTestOptions } = testFlags @@ -1160,6 +1162,8 @@ convertToLegacyPerPackageConfig PackageConfig{..} = , testKeepTix = packageConfigTestKeepTix , testWrapper = packageConfigTestWrapper , testFailWhenNoTestSuites = packageConfigTestFailWhenNoTestSuites + , testCoverageLibsModules = mempty + , testCoverageDistPrefs = mempty , testOptions = packageConfigTestTestOptions } diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 5cb04eaf56b..31994b90d9e 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -1,12 +1,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE NoMonoLocalBinds #-} +{-# LANGUAGE NoMonoLocalBinds #-} -- MUST come after TypeFamilies because TypeFamilies imply MonoLocalBinds -- | Planning how to build everything in a project. module Distribution.Client.ProjectPlanning @@ -150,7 +151,7 @@ import Distribution.Simple.Setup , flagToList , flagToMaybe , fromFlagOrDefault - , toFlag + , toFlag, TestFlags (testCoverageDistPrefs) ) import qualified Distribution.Simple.Setup as Cabal import Distribution.System @@ -1675,7 +1676,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 @@ -1712,12 +1713,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 @@ -4285,12 +4280,14 @@ setupHsBuildArgs (ElaboratedConfiguredPackage{elabPkgOrComp = ElabComponent _}) [] setupHsTestFlags - :: ElaboratedConfiguredPackage + :: ElaboratedInstallPlan + -> ElaboratedConfiguredPackage -> ElaboratedSharedConfig -> Verbosity + -> DistDirLayout -> FilePath -> Cabal.TestFlags -setupHsTestFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir = +setupHsTestFlags plan (ElaboratedConfiguredPackage{..}) sharedConfig verbosity distDirLayout builddir = Cabal.TestFlags { testDistPref = toFlag builddir , testVerbosity = toFlag verbosity @@ -4300,8 +4297,40 @@ setupHsTestFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir = , 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 + -- TODO: This currently also includes the testsuite's prefix + -- 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@ElaboratedConfiguredPackage{elabModuleShape=modShape} + | elabLocalToProject + , not (isIndefiniteOrInstantiation modShape) + -> Just elab + InstallPlan.Configured elab@ElaboratedConfiguredPackage{elabModuleShape=modShape} + | elabLocalToProject + , not (isIndefiniteOrInstantiation modShape) + -> Just elab + _ -> Nothing + ) $ Graph.toList $ InstallPlan.toGraph plan + + isIndefiniteOrInstantiation :: ModuleShape -> Bool + isIndefiniteOrInstantiation = not . Set.null . modShapeRequires setupHsTestArgs :: ElaboratedConfiguredPackage -> [String] -- TODO: Does the issue #3335 affects test as well @@ -4436,16 +4465,6 @@ setupHsHaddockArgs :: ElaboratedConfiguredPackage -> [String] setupHsHaddockArgs elab = map (showComponentTarget (packageId elab)) (elabHaddockTargets elab) -{- -setupHsTestFlags :: ElaboratedConfiguredPackage - -> ElaboratedSharedConfig - -> Verbosity - -> FilePath - -> Cabal.TestFlags -setupHsTestFlags _ _ verbosity builddir = - Cabal.TestFlags { - } --} ------------------------------------------------------------------------------ diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index e752b573aad..3d07ec702fe 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -171,6 +171,7 @@ import Distribution.Simple.Flag , flagToMaybe , fromFlagOrDefault , maybeToFlag + , mergeListFlag , toFlag ) import Distribution.Simple.InstallDirs @@ -1106,6 +1107,8 @@ filterTestFlags flags cabalLibVersion flags_latest { -- Cabal < 3.0 doesn't know about --test-wrapper Cabal.testWrapper = NoFlag + , Cabal.testCoverageLibsModules = NoFlag + , Cabal.testCoverageDistPrefs = NoFlag } -- ------------------------------------------------------------ @@ -3164,10 +3167,6 @@ initOptions _ = ("Cannot parse dependencies: " ++) (parsecCommaList parsec) - mergeListFlag :: Flag [a] -> Flag [a] -> Flag [a] - mergeListFlag currentFlags v = - Flag $ concat (flagToList currentFlags ++ flagToList v) - -- ------------------------------------------------------------ -- * Copy and Register diff --git a/cabal-testsuite/PackageTests/Backpack/Includes2/Includes2.cabal b/cabal-testsuite/PackageTests/Backpack/Includes2/Includes2.cabal index 7a02fcd961c..51c4768bb06 100644 --- a/cabal-testsuite/PackageTests/Backpack/Includes2/Includes2.cabal +++ b/cabal-testsuite/PackageTests/Backpack/Includes2/Includes2.cabal @@ -39,3 +39,10 @@ executable exe main-is: Main.hs hs-source-dirs: exe default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + build-depends: base, Includes2 + main-is: test.hs + hs-source-dirs: test + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Backpack/Includes2/enable-coverage.test.hs b/cabal-testsuite/PackageTests/Backpack/Includes2/enable-coverage.test.hs new file mode 100644 index 00000000000..918d141acf1 --- /dev/null +++ b/cabal-testsuite/PackageTests/Backpack/Includes2/enable-coverage.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude +main = cabalTest $ do + skipUnlessGhcVersion ">= 8.1" + -- #6397 + cabal "test" ["--enable-coverage"] diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/Successful/cabal.test.hs b/cabal-testsuite/PackageTests/MultipleLibraries/Successful/cabal.test.hs index 88606589192..892b8d381d3 100644 --- a/cabal-testsuite/PackageTests/MultipleLibraries/Successful/cabal.test.hs +++ b/cabal-testsuite/PackageTests/MultipleLibraries/Successful/cabal.test.hs @@ -2,3 +2,6 @@ import Test.Cabal.Prelude main = cabalTest $ cabal' "v2-run" ["pkg-abc:program"] >>= assertOutputContains "pkg-def:publib" + -- # #8609 + cabal' "v2-test" ["--enable-coverage", "all"] + diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/Successful/pkg-abc/pkg-abc.cabal b/cabal-testsuite/PackageTests/MultipleLibraries/Successful/pkg-abc/pkg-abc.cabal index feed99fd047..6cb377aecb4 100644 --- a/cabal-testsuite/PackageTests/MultipleLibraries/Successful/pkg-abc/pkg-abc.cabal +++ b/cabal-testsuite/PackageTests/MultipleLibraries/Successful/pkg-abc/pkg-abc.cabal @@ -8,3 +8,11 @@ executable program build-depends: , base , pkg-def:publib + +test-suite program-test + type: exitcode-stdio-1.0 + default-language: Haskell2010 + main-is: Main.hs + build-depends: + , base + , pkg-def:publib diff --git a/cabal-testsuite/PackageTests/Regression/T4798/T4798.cabal b/cabal-testsuite/PackageTests/Regression/T4798/T4798.cabal new file mode 100644 index 00000000000..d51b290b569 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T4798/T4798.cabal @@ -0,0 +1,18 @@ +cabal-version: 3.0 +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 diff --git a/cabal-testsuite/PackageTests/Regression/T4798/cabal.project b/cabal-testsuite/PackageTests/Regression/T4798/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T4798/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/Regression/T4798/cabal.test.hs b/cabal-testsuite/PackageTests/Regression/T4798/cabal.test.hs new file mode 100644 index 00000000000..0d594011fc2 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T4798/cabal.test.hs @@ -0,0 +1,3 @@ +import Test.Cabal.Prelude +main = cabalTest $ cabal "test" ["--enable-coverage"] + diff --git a/cabal-testsuite/PackageTests/Regression/T4798/src/U2F.hs b/cabal-testsuite/PackageTests/Regression/T4798/src/U2F.hs new file mode 100644 index 00000000000..28d9b767995 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T4798/src/U2F.hs @@ -0,0 +1,6 @@ +module U2F where + +import U2F.Types + +ourCurve :: String +ourCurve = show SEC_p256r1 diff --git a/cabal-testsuite/PackageTests/Regression/T4798/src/U2F/Types.hs b/cabal-testsuite/PackageTests/Regression/T4798/src/U2F/Types.hs new file mode 100644 index 00000000000..92accffdcff --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T4798/src/U2F/Types.hs @@ -0,0 +1,3 @@ +module U2F.Types where + +data Curve = SEC_p256r1 deriving Show diff --git a/cabal-testsuite/PackageTests/Regression/T4798/tests/test.hs b/cabal-testsuite/PackageTests/Regression/T4798/tests/test.hs new file mode 100644 index 00000000000..e637e0cf66b --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T4798/tests/test.hs @@ -0,0 +1,6 @@ +import U2F +import U2F.Types + +main = print ourCurve +main :: IO () + diff --git a/cabal-testsuite/PackageTests/Regression/T6440/cabal.project b/cabal-testsuite/PackageTests/Regression/T6440/cabal.project new file mode 100644 index 00000000000..b764c340a62 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T6440/cabal.project @@ -0,0 +1,2 @@ +packages: . + diff --git a/cabal-testsuite/PackageTests/Regression/T6440/cabal.test.hs b/cabal-testsuite/PackageTests/Regression/T6440/cabal.test.hs new file mode 100644 index 00000000000..0932c665f31 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T6440/cabal.test.hs @@ -0,0 +1,2 @@ +import Test.Cabal.Prelude +main = cabalTest $ cabal "test" ["--enable-coverage"] diff --git a/cabal-testsuite/PackageTests/Regression/T6440/cabal6440.cabal b/cabal-testsuite/PackageTests/Regression/T6440/cabal6440.cabal new file mode 100644 index 00000000000..42192a71672 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T6440/cabal6440.cabal @@ -0,0 +1,23 @@ +cabal-version: 3.0 +name: cabal6440 +version: 0.1 + +library + exposed-modules: Top + -- other-extensions: + build-depends: base, cabal6440:intern6440 + hs-source-dirs: src + default-language: Haskell2010 + +library intern6440 + exposed-modules: Inn + build-depends: base + hs-source-dirs: srcint + + +test-suite tests + main-is: Main.hs + type: exitcode-stdio-1.0 + build-depends: base, cabal6440 + hs-source-dirs: tests + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Regression/T6440/src/Top.hs b/cabal-testsuite/PackageTests/Regression/T6440/src/Top.hs new file mode 100644 index 00000000000..66539d28e3b --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T6440/src/Top.hs @@ -0,0 +1,5 @@ +module Top where +import Inn + +foo :: String +foo = bar diff --git a/cabal-testsuite/PackageTests/Regression/T6440/srcint/Inn.hs b/cabal-testsuite/PackageTests/Regression/T6440/srcint/Inn.hs new file mode 100644 index 00000000000..e77f8fd85a3 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T6440/srcint/Inn.hs @@ -0,0 +1,4 @@ +module Inn where + +bar :: String +bar = "internal" diff --git a/cabal-testsuite/PackageTests/Regression/T6440/tests/Main.hs b/cabal-testsuite/PackageTests/Regression/T6440/tests/Main.hs new file mode 100644 index 00000000000..89a8e05f0e5 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T6440/tests/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Top + +main :: IO () +main = print foo diff --git a/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/setup-no-markup.test.hs b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/setup-no-markup.test.hs index 99140253d55..4db84dcec46 100644 --- a/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/setup-no-markup.test.hs +++ b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/setup-no-markup.test.hs @@ -13,4 +13,4 @@ main = setupAndCabalTest $ do , "--ghc-option=-hpcdir" , "--ghc-option=" ++ dist_dir ++ "/hpc/vanilla" ] setup "test" ["test-Short", "--show-details=direct"] - shouldNotExist $ htmlDir dist_dir Vanilla "test-Short" "hpc_index.html" + shouldNotExist $ htmlDir dist_dir Vanilla "hpc_index.html" diff --git a/cabal.project.coverage b/cabal.project.coverage index 2afe3d10df7..a6f9eefd03a 100644 --- a/cabal.project.coverage +++ b/cabal.project.coverage @@ -31,44 +31,3 @@ constraints: these program-options ghc-options: -fno-ignore-asserts --- NOTE: for library coverage in multi-project builds, --- see: --- --- * https://github.com/haskell/cabal/issues/6440 --- * https://github.com/haskell/cabal/issues/5213#issuecomment-586517129 --- --- We must mask coverage for dependencies of `cabal-install` in --- multiproject settings in order to generate coverage for --- the `cabal-install` library --- -package Cabal-syntax - coverage: False - library-coverage: False - -package Cabal - coverage: False - library-coverage: False - -package cabal-testsuite - coverage: False - library-coverage: False - -package Cabal-QuickCheck - coverage: False - library-coverage: False - -package Cabal-tree-diff - coverage: False - library-coverage: False - -package Cabal-described - coverage: False - library-coverage: False - -package cabal-install-solver - coverage: False - library-coverage: False - -package cabal-install - coverage: True - library-coverage: True