From ff03e645fc12a924458b2289380b0345534d5be5 Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Wed, 22 Nov 2023 16:06:39 +0000 Subject: [PATCH] Per-component multi-package builds with coverage enabled This commits re-enables per-component builds when coverage checking is enabled. This restriction was previously added in #5004 to fix #4798. - #4798 was subsequently fixed "again" with the fix for #5213, in #7493 by fixing the paths of the testsuite `.mix` files to the same location as that of the main library component. Therefore the restriction to treat testsuites per-package (legacy-fallback) is no longer needed. We went further and fixed coverage for internal sublibraries, packages with backpack (but without generating coverage information for indefinite and instantiated units -- it is not clear what it would mean for HPC to support this), and coverage for multi-package projects. 1. We allow hpc in per-component builds 2. To generate hpc files in the appropriate component directories in the distribution tree, we remove the hack from #7493 and instead determine the `.mix` directories that are included in the call to `hpc markup` by passing the list of libraries in the project from the cabal-install invocation of test. We also drop an unnecessary directory in the hpc file hierarchy. 3. To account for internal (non-backpack) libraries, we include the mix dirs and modules of all (non-indefinite and non-instantiations) libraries in the project Indefinite libraries and instantiations are ignored as it is not obvious what it means for HPC to support backpack, e.g. covering a library function that two different instantiations 4. We now only reject coverage if there are no libraries at all in the project, rather than if there are no libraries in the package. This allows us to drop the coverage masking logic in cabal.project.coverage while still having coverage of cabal-install (i.e. cabal test --enable-coverage cabal-install now works without the workaround) Even though we allow multi-package project coverage, we still cover each package independently -- the tix files resulting from all packages are not combined for the time being. Includes tests for #6440, #6397, #8609, and #4798 (the test for #5213 already exists) Fixes #6440 (internal libs coverage), #6397 (backpack breaks coverage) , #8609 (multi-package coverage report) and fixes in a new way the previously fixed #4798, #5213. --- Cabal/src/Distribution/Simple/Errors.hs | 4 +- Cabal/src/Distribution/Simple/Flag.hs | 7 + Cabal/src/Distribution/Simple/GHC.hs | 9 +- Cabal/src/Distribution/Simple/GHCJS.hs | 11 +- Cabal/src/Distribution/Simple/Hpc.hs | 136 ++++++------------ Cabal/src/Distribution/Simple/Setup/Test.hs | 43 ++++++ Cabal/src/Distribution/Simple/Test.hs | 2 +- Cabal/src/Distribution/Simple/Test/ExeV10.hs | 11 +- Cabal/src/Distribution/Simple/Test/LibV09.hs | 12 +- .../src/Distribution/Types/LocalBuildInfo.hs | 1 + .../src/Distribution/Client/Config.hs | 2 + .../Distribution/Client/ProjectBuilding.hs | 2 + .../Client/ProjectConfig/Legacy.hs | 4 + .../Distribution/Client/ProjectPlanning.hs | 57 +++++--- .../src/Distribution/Client/Setup.hs | 6 +- .../Backpack/Includes2/Includes2.cabal | 7 + .../Includes2/enable-coverage.test.hs | 5 + .../Successful/cabal.test.hs | 3 + .../Successful/pkg-abc/pkg-abc.cabal | 8 ++ .../PackageTests/Regression/T4798/T4798.cabal | 18 +++ .../Regression/T4798/cabal.project | 1 + .../Regression/T4798/cabal.test.hs | 3 + .../PackageTests/Regression/T4798/src/U2F.hs | 6 + .../Regression/T4798/src/U2F/Types.hs | 3 + .../Regression/T4798/tests/test.hs | 6 + .../Regression/T6440/cabal.project | 2 + .../Regression/T6440/cabal.test.hs | 2 + .../Regression/T6440/cabal6440.cabal | 23 +++ .../PackageTests/Regression/T6440/src/Top.hs | 5 + .../Regression/T6440/srcint/Inn.hs | 4 + .../Regression/T6440/tests/Main.hs | 6 + .../ExeV10/setup-no-markup.test.hs | 2 +- cabal.project.coverage | 41 ------ 33 files changed, 263 insertions(+), 189 deletions(-) create mode 100644 cabal-testsuite/PackageTests/Backpack/Includes2/enable-coverage.test.hs create mode 100644 cabal-testsuite/PackageTests/Regression/T4798/T4798.cabal create mode 100644 cabal-testsuite/PackageTests/Regression/T4798/cabal.project create mode 100644 cabal-testsuite/PackageTests/Regression/T4798/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Regression/T4798/src/U2F.hs create mode 100644 cabal-testsuite/PackageTests/Regression/T4798/src/U2F/Types.hs create mode 100644 cabal-testsuite/PackageTests/Regression/T4798/tests/test.hs create mode 100644 cabal-testsuite/PackageTests/Regression/T6440/cabal.project create mode 100644 cabal-testsuite/PackageTests/Regression/T6440/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Regression/T6440/cabal6440.cabal create mode 100644 cabal-testsuite/PackageTests/Regression/T6440/src/Top.hs create mode 100644 cabal-testsuite/PackageTests/Regression/T6440/srcint/Inn.hs create mode 100644 cabal-testsuite/PackageTests/Regression/T6440/tests/Main.hs 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.hs b/Cabal/src/Distribution/Simple/GHC.hs index 3c380a41a86..5ff9d39bc58 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -643,15 +643,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 @@ -1548,7 +1543,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/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index 58194f5ffa3..246ea24db47 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..946ddf9afe7 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,58 +112,22 @@ 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{testCoverageLibsDistPref, testCoverageLibsModules} lbi testDistPref pkg_descr suites = do + let tixFiles = map (tixFilePath testDistPref way) testNames tixFilesExist <- traverse doesFileExist tixFiles + putStrLn "ROMES: WRITING" + print testCoverageLibsDistPref + print testCoverageLibsModules when (and tixFilesExist) $ do -- behaviour of 'markup' depends on version, so we need *a* version -- but no particular one @@ -202,12 +137,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 +171,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 = mixDir testDistPref way : map (`mixDir` way) (fromFlagOrDefault [] testCoverageLibsDistPref) + included = fromFlagOrDefault [] testCoverageLibsModules + diff --git a/Cabal/src/Distribution/Simple/Setup/Test.hs b/Cabal/src/Distribution/Simple/Setup/Test.hs index bee0ccbef1a..f239c3b7a3e 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. + , testCoverageLibsDistPref :: Flag [FilePath] + -- ^ The path to each main or sub library local to this project 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 library 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 + , testCoverageLibsDistPref = 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 library" + testCoverageLibsDistPref + (\v flags -> + flags{ testCoverageLibsDistPref = + mergeListFlag (testCoverageLibsDistPref 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..6219701c045 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 $ testCoverageLibsDistPref 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..1e2ac0ba373 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 $ testCoverageLibsDistPref 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..4545c27979e 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 + , testCoverageLibsDistPref = combine testCoverageLibsDistPref , 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..28cc41cf48d 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 = _ + , testCoverageLibsDistPref = _ , testOptions = packageConfigTestTestOptions } = testFlags @@ -1160,6 +1162,8 @@ convertToLegacyPerPackageConfig PackageConfig{..} = , testKeepTix = packageConfigTestKeepTix , testWrapper = packageConfigTestWrapper , testFailWhenNoTestSuites = packageConfigTestFailWhenNoTestSuites + , testCoverageLibsModules = mempty + , testCoverageLibsDistPref = mempty , testOptions = packageConfigTestTestOptions } diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 44372967fdb..c30ac4f0fcd 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 (testCoverageLibsDistPref) ) import qualified Distribution.Simple.Setup as Cabal import Distribution.System @@ -1673,7 +1674,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 @@ -1710,12 +1711,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 @@ -4302,12 +4297,17 @@ 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 = + trace (show $ (covIncludeModules, covLibsDistPref)) $! + -- traceShow mixDirs $! + -- traceShow includeModules $! Cabal.TestFlags { testDistPref = toFlag builddir , testVerbosity = toFlag verbosity @@ -4317,8 +4317,33 @@ setupHsTestFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir = , testKeepTix = toFlag elabTestKeepTix , testWrapper = maybe mempty toFlag elabTestWrapper , testFailWhenNoTestSuites = toFlag elabTestFailWhenNoTestSuites + , testCoverageLibsModules = toFlag covIncludeModules + , testCoverageLibsDistPref = 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 + 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 @@ -4453,16 +4478,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 6d04d401a8a..0fa4a6633d5 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -167,6 +167,7 @@ import Distribution.Simple.Flag , flagToMaybe , fromFlagOrDefault , maybeToFlag + , mergeListFlag , toFlag ) import Distribution.Simple.InstallDirs @@ -1102,6 +1103,7 @@ filterTestFlags flags cabalLibVersion { -- Cabal < 3.0 doesn't know about --test-wrapper Cabal.testWrapper = NoFlag } +-- ROMES:TODO: Do I need to add coverage thing here -- ------------------------------------------------------------ @@ -3159,10 +3161,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