diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index 7e5f54f64fc..cdf6e4fb435 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) - 0x23942cff98237dc167ef90d64d7ef893 + 0x023b3cd1665b2acdedf72d231c96336b #else - 0xa4e9f8a7e1583906880d6ec2d1bbb14b + 0xc6c0cc122cc60ce7943764cbaaacdc2d #endif diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index b7aabf65f18..1cd864a290b 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,28 @@ getInstalledPackagesMonitorFiles verbosity comp packageDBs progdb platform = ++ prettyShow other return [] +-- | Looks up the 'InstalledPackageInfo' of the given 'UnitId's from the +-- 'PackageDBStack' in the 'LocalBuildInfo'. +getInstalledPackagesById + :: (Exception (VerboseException exception), Show exception, Typeable exception) + => Verbosity + -> LocalBuildInfo + -> (UnitId -> exception) + -- ^ Construct an exception that is thrown if a + -- unit-id is not found in the installed packages, + -- from the unit-id that is missing. + -> [UnitId] + -- ^ The unit ids to lookup in the installed packages + -> IO [InstalledPackageInfo] +getInstalledPackagesById verbosity LocalBuildInfo{compiler, withPackageDB, withPrograms} mkException unitids = do + ipindex <- getInstalledPackages verbosity compiler withPackageDB withPrograms + mapM + ( \uid -> case lookupUnitId ipindex uid of + Nothing -> dieWithException verbosity (mkException uid) + Just ipkg -> return ipkg + ) + unitids + -- | The user interface specifies the package dbs to use with a combination of -- @--global@, @--user@ and @--package-db=global|user|clear|$file@. -- This function combines the global/user flag and interprets the package-db 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/Flag.hs b/Cabal/src/Distribution/Simple/Flag.hs index 095fe7b9dde..f8598697028 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,11 @@ maybeToFlag :: Maybe a -> Flag a maybeToFlag Nothing = NoFlag maybeToFlag (Just x) = Flag x +-- | Merge the elements of a list 'Flag' with another list 'Flag'. +mergeListFlag :: Flag [a] -> Flag [a] -> Flag [a] +mergeListFlag currentFlags v = + Flag $ concat (flagToList currentFlags ++ flagToList v) + -- | Types that represent boolean flags. class BooleanFlag a where asBool :: a -> Bool diff --git a/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs b/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs index e4c4408b40b..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 (gbuildName bm) + | 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 9786470a990..8ae87642b51 100644 --- a/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs +++ b/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs @@ -7,10 +7,8 @@ import Control.Monad (forM_) import qualified Distribution.ModuleName as ModuleName import Distribution.Package import Distribution.PackageDescription as PD -import Distribution.Pretty import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler -import Distribution.Simple.Flag (Flag (..), fromFlag, toFlag) import Distribution.Simple.GHC.Build ( checkNeedsRecompilation , componentGhcOptions @@ -28,7 +26,7 @@ import Distribution.Simple.Program import qualified Distribution.Simple.Program.Ar as Ar import Distribution.Simple.Program.GHC import qualified Distribution.Simple.Program.Ld as Ld -import Distribution.Simple.Setup.Config +import Distribution.Simple.Setup.Common import Distribution.Simple.Setup.Repl import Distribution.Simple.Utils import Distribution.System @@ -97,15 +95,9 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do -- Determine if program coverage should be enabled and if so, what -- '-hpcdir' should be. let isCoverageEnabled = libCoverage lbi - -- TODO: Historically HPC files have been put into a directory which - -- has the package name. I'm going to avoid changing this for - -- now, but it would probably be better for this to be the - -- component ID instead... - pkg_name = prettyShow (PD.package pkg_descr) - distPref = fromFlag $ configDistPref $ configFlags lbi hpcdir way | forRepl = mempty -- HPC is not supported in ghci - | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name + | isCoverageEnabled = toFlag $ Hpc.mixDir (libTargetDir extraCompilationArtifacts) way | otherwise = mempty createDirectoryIfMissingVerbose verbosity True libTargetDir diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index c13afba220c..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 @@ -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,9 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do -- Determine if program coverage should be enabled and if so, what -- '-hpcdir' should be. let isCoverageEnabled = libCoverage lbi - -- TODO: Historically HPC files have been put into a directory which - -- has the package name. I'm going to avoid changing this for - -- now, but it would probably be better for this to be the - -- component ID instead... - pkg_name = prettyShow (PD.package pkg_descr) - distPref = fromFlag $ configDistPref $ configFlags lbi hpcdir way | forRepl = mempty -- HPC is not supported in ghci - | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name + | isCoverageEnabled = toFlag $ Hpc.mixDir (libTargetDir extraCompilationArtifacts) way | otherwise = mempty createDirectoryIfMissingVerbose verbosity True libTargetDir @@ -1240,10 +1234,9 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do -- Determine if program coverage should be enabled and if so, what -- '-hpcdir' should be. let isCoverageEnabled = exeCoverage lbi - distPref = fromFlag $ configDistPref $ configFlags lbi hpcdir way | gbuildIsRepl bm = mempty -- HPC is not supported in ghci - | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way (gbuildName bm) + | isCoverageEnabled = toFlag $ Hpc.mixDir (tmpDir extraCompilationArtifacts) way | otherwise = mempty rpaths <- getRPaths lbi clbi diff --git a/Cabal/src/Distribution/Simple/Hpc.hs b/Cabal/src/Distribution/Simple/Hpc.hs index 5d24f190b7e..158051b0924 100644 --- a/Cabal/src/Distribution/Simple/Hpc.hs +++ b/Cabal/src/Distribution/Simple/Hpc.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} ----------------------------------------------------------------------------- @@ -21,17 +22,16 @@ module Distribution.Simple.Hpc , mixDir , tixDir , tixFilePath + , HPCMarkupInfo (..) , markupPackage - , markupTest ) where import Distribution.Compat.Prelude import Prelude () -import Distribution.ModuleName (main) +import Distribution.ModuleName (ModuleName, main) import Distribution.PackageDescription - ( Library (..) - , TestSuite (..) + ( TestSuite (..) , testModules ) import qualified Distribution.PackageDescription as PD @@ -73,44 +73,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 +93,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 +111,28 @@ 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] +-- | 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 all of a package's test suites. +-- | Generate the HTML markup for a package's test suites. markupPackage :: Verbosity + -> HPCMarkupInfo -> 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 HPCMarkupInfo{pathsToLibsArtifacts, libsModulesToInclude} 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 +143,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' libsModulesToInclude notice verbosity $ "Package coverage report written to " ++ htmlDir' @@ -215,6 +177,4 @@ 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) 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/Test.hs b/Cabal/src/Distribution/Simple/Test.hs index 7cb695cabaf..e24a7b0ed45 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 MissingCoveredInstalledLibrary 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 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 04c7e30073a..0cf2ec3d12a 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 @@ -45,13 +44,14 @@ 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 testName' + tixDir_ = tixDir distPref way pwd <- getCurrentDirectory existingEnv <- getEnvironment @@ -170,12 +170,16 @@ runTest pkg_descr lbi clbi flags suite = do -- Write summary notice to terminal indicating end of test suite 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 + when isCoverageEnabled $ do + -- Until #9493 is fixed, we expect cabal-install to pass one dist dir per + -- library and there being at least one library in the package with the + -- testsuite. When it is fixed, we can remove this predicate and allow a + -- testsuite without a library to cover libraries in other packages of the + -- same project + when (null $ PD.allLibraries pkg_descr) $ + dieWithException verbosity TestCoverageSupport + + 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 b87897bfed7..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 @@ -80,12 +81,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' @@ -185,12 +186,16 @@ runTest pkg_descr lbi clbi flags suite = do -- Write summary notice to terminal indicating end of test suite 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 + when isCoverageEnabled $ do + -- Until #9493 is fixed, we expect cabal-install to pass one dist dir per + -- library and there being at least one library in the package with the + -- testsuite. When it is fixed, we can remove this predicate and allow a + -- testsuite without a library to cover libraries in other packages of the + -- same project + when (null $ PD.allLibraries pkg_descr) $ + dieWithException verbosity TestCoverageSupport + + markupPackage verbosity hpcMarkupInfo 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..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 diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs index e0c97aca924..84ae5da18e8 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs @@ -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 @@ -1735,7 +1737,6 @@ buildInplaceUnpackedPackage flip filterTestFlags v $ setupHsTestFlags pkg - pkgshared verbosity 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..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) @@ -1037,6 +1038,7 @@ convertToLegacyAllPackageConfig , configUseResponseFiles = mempty , configDumpBuildInfo = mempty , configAllowDependingOnPrivateLibs = mempty + , configCoverageFor = mempty } haddockFlags = @@ -1113,6 +1115,7 @@ convertToLegacyPerPackageConfig PackageConfig{..} = , configUseResponseFiles = mempty , configDumpBuildInfo = packageConfigDumpBuildInfo , configAllowDependingOnPrivateLibs = mempty + , configCoverageFor = mempty } installFlags = 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 b5c18c6cbc3..6d63ffcbaab 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} @@ -1634,7 +1635,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 @@ -1671,12 +1672,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 @@ -3851,12 +3846,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 @@ -4002,6 +3999,8 @@ setupHsConfigureFlags Just _ -> error "non-library dependency" Nothing -> LMainLibName + configCoverageFor = determineCoverageFor elabPkgSourceId plan + setupHsConfigureArgs :: ElaboratedConfiguredPackage -> [String] @@ -4049,11 +4048,10 @@ setupHsBuildArgs (ElaboratedConfiguredPackage{elabPkgOrComp = ElabComponent _}) setupHsTestFlags :: ElaboratedConfiguredPackage - -> ElaboratedSharedConfig -> Verbosity -> FilePath -> Cabal.TestFlags -setupHsTestFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir = +setupHsTestFlags (ElaboratedConfiguredPackage{..}) verbosity builddir = Cabal.TestFlags { testDistPref = toFlag builddir , testVerbosity = toFlag verbosity @@ -4199,17 +4197,6 @@ setupHsHaddockArgs :: ElaboratedConfiguredPackage -> [String] setupHsHaddockArgs elab = map (showComponentTarget (packageId elab)) (elabHaddockTargets elab) -{- -setupHsTestFlags :: ElaboratedConfiguredPackage - -> ElaboratedSharedConfig - -> Verbosity - -> FilePath - -> Cabal.TestFlags -setupHsTestFlags _ _ verbosity builddir = - Cabal.TestFlags { - } --} - ------------------------------------------------------------------------------ -- * Sharing installed packages @@ -4417,3 +4404,40 @@ 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 elab@ElaboratedConfiguredPackage{elabModuleShape, elabPkgSourceId, elabLocalToProject} = + elabLocalToProject + && not (isIndefiniteOrInstantiation elabModuleShape) + -- TODO(#9493): We can only cover libraries in the same package + -- as the testsuite + && configuredPkgSourceId == elabPkgSourceId + -- Libraries only! We don't cover testsuite modules, so we never need + -- the paths to their mix dirs. Furthermore, we do not install testsuites... + && maybe False (\case CLibName{} -> True; CNotLibName{} -> False) (elabComponentName elab) + + 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 e752b573aad..a5d91aaf19b 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 @@ -676,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 = @@ -3164,10 +3170,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..e6aa6169e68 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 includes2-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/cabal.project b/cabal-testsuite/PackageTests/Backpack/Includes2/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/Backpack/Includes2/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/Backpack/Includes2/cov.out b/cabal-testsuite/PackageTests/Backpack/Includes2/cov.out new file mode 100644 index 00000000000..784baff09e7 --- /dev/null +++ b/cabal-testsuite/PackageTests/Backpack/Includes2/cov.out @@ -0,0 +1,48 @@ +# cabal test +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - Includes2-0.1.0.0 (lib:mylib) (first run) + - Includes2-0.1.0.0 (lib:mysql) (first run) + - Includes2-0.1.0.0 (lib:postgresql) (first run) + - Includes2-0.1.0.0 (lib:mylib with Database=Includes2-0.1.0.0-inplace-mysql:Database.MySQL) (first run) + - Includes2-0.1.0.0 (lib:mylib with Database=Includes2-0.1.0.0-inplace-postgresql:Database.PostgreSQL) (first run) + - Includes2-0.1.0.0 (lib) (first run) + - Includes2-0.1.0.0 (test:includes2-test) (first run) +Configuring library 'mylib' for Includes2-0.1.0.0... +Preprocessing library 'mylib' for Includes2-0.1.0.0... +Building library 'mylib' instantiated with Database = +for Includes2-0.1.0.0... +Configuring library 'mysql' for Includes2-0.1.0.0... +Preprocessing library 'mysql' for Includes2-0.1.0.0... +Building library 'mysql' for Includes2-0.1.0.0... +Configuring library 'postgresql' for Includes2-0.1.0.0... +Preprocessing library 'postgresql' for Includes2-0.1.0.0... +Building library 'postgresql' for Includes2-0.1.0.0... +Configuring library 'mylib' instantiated with + Database = Includes2-0.1.0.0-inplace-mysql:Database.MySQL +for Includes2-0.1.0.0... +Preprocessing library 'mylib' for Includes2-0.1.0.0... +Building library 'mylib' instantiated with + Database = Includes2-0.1.0.0-inplace-mysql:Database.MySQL +for Includes2-0.1.0.0... +Configuring library 'mylib' instantiated with + Database = Includes2-0.1.0.0-inplace-postgresql:Database.PostgreSQL +for Includes2-0.1.0.0... +Preprocessing library 'mylib' for Includes2-0.1.0.0... +Building library 'mylib' instantiated with + Database = Includes2-0.1.0.0-inplace-postgresql:Database.PostgreSQL +for Includes2-0.1.0.0... +Configuring library for Includes2-0.1.0.0... +Preprocessing library for Includes2-0.1.0.0... +Building library for Includes2-0.1.0.0... +Configuring test suite 'includes2-test' for Includes2-0.1.0.0... +Preprocessing test suite 'includes2-test' for Includes2-0.1.0.0... +Building test suite 'includes2-test' for Includes2-0.1.0.0... +Running 1 test suites... +Test suite includes2-test: RUNNING... +Test suite includes2-test: PASS +Test suite logged to: /cov.dist/work/./dist/build//ghc-/Includes2-0.1.0.0/t/includes2-test/test/Includes2-0.1.0.0-includes2-test.log +Package coverage report written to /cov.dist/work/./dist/build//ghc-/Includes2-0.1.0.0/t/includes2-test/hpc/vanilla/html/hpc_index.html +1 of 1 test suites (1 of 1 test cases) passed. +Package coverage report written to /cov.dist/work/./dist/build//ghc-/Includes2-0.1.0.0/t/includes2-test/hpc/vanilla/html/hpc_index.html diff --git a/cabal-testsuite/PackageTests/Backpack/Includes2/cov.test.hs b/cabal-testsuite/PackageTests/Backpack/Includes2/cov.test.hs new file mode 100644 index 00000000000..24c1662c375 --- /dev/null +++ b/cabal-testsuite/PackageTests/Backpack/Includes2/cov.test.hs @@ -0,0 +1,6 @@ +import Test.Cabal.Prelude +main = cabalTest $ do + skipUnlessGhcVersion ">= 8.1" + skipIfWindows -- TODO: https://github.com/haskell/cabal/issues/6271 + -- #6397 + cabal "test" ["--enable-coverage", "includes2-test"] diff --git a/cabal-testsuite/PackageTests/Backpack/Includes2/test/test.hs b/cabal-testsuite/PackageTests/Backpack/Includes2/test/test.hs new file mode 100644 index 00000000000..c90460e80f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/Backpack/Includes2/test/test.hs @@ -0,0 +1,2 @@ +import App +main = putStrLn app 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.out b/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.out new file mode 100644 index 00000000000..a650ce81c42 --- /dev/null +++ b/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.out @@ -0,0 +1,17 @@ +# cabal test +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - plain-0.1.0.0 *test (first run) +Configuring plain-0.1.0.0... +Preprocessing library for plain-0.1.0.0.. +Building library for plain-0.1.0.0.. +Preprocessing test suite 'test' for plain-0.1.0.0.. +Building test suite 'test' for plain-0.1.0.0.. +Running 1 test suites... +Test suite test: RUNNING... +Test suite test: PASS +Test suite logged to: /cabal.dist/work/./dist/build//ghc-/plain-0.1.0.0/test/plain-0.1.0.0-test.log +Test coverage report written to /cabal.dist/work/./dist/build//ghc-/plain-0.1.0.0/hpc/vanilla/html/test/hpc_index.html +1 of 1 test suites (1 of 1 test cases) passed. +Package coverage report written to /cabal.dist/work/./dist/build//ghc-/plain-0.1.0.0/hpc/vanilla/html/plain-0.1.0.0/hpc_index.html 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..6f3f5586c62 --- /dev/null +++ b/cabal-testsuite/PackageTests/CustomTestCoverage/cabal.test.hs @@ -0,0 +1,3 @@ +import Test.Cabal.Prelude +main = cabalTest $ do + 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..c14b6534f32 --- /dev/null +++ b/cabal-testsuite/PackageTests/CustomTestCoverage/plain.cabal @@ -0,0 +1,23 @@ +cabal-version: 2.2 +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 + default-language: Haskell2010 + 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..7f40ed74bc8 --- /dev/null +++ b/cabal-testsuite/PackageTests/CustomTestCoverage/setup.test.hs @@ -0,0 +1,7 @@ +import Test.Cabal.Prelude +main = setupTest $ do + recordMode DoNotRecord $ do + skipUnless "no Cabal for GHC" =<< hasCabalForGhc + setup' "configure" ["--enable-tests", "--enable-coverage"] >>= assertOutputContains "ThisIsCustomYeah" + setup' "build" [] + setup' "test" [] >>= assertOutputContains "Package coverage report written to" 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 diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/Successful/cabal.test.hs b/cabal-testsuite/PackageTests/MultipleLibraries/Successful/cabal.test.hs index 88606589192..c9cb80255f8 100644 --- a/cabal-testsuite/PackageTests/MultipleLibraries/Successful/cabal.test.hs +++ b/cabal-testsuite/PackageTests/MultipleLibraries/Successful/cabal.test.hs @@ -1,4 +1,4 @@ import Test.Cabal.Prelude -main = cabalTest $ +main = cabalTest $ do cabal' "v2-run" ["pkg-abc:program"] >>= assertOutputContains "pkg-def:publib" - + return () diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/Successful/coverage.test.hs b/cabal-testsuite/PackageTests/MultipleLibraries/Successful/coverage.test.hs new file mode 100644 index 00000000000..491afc9ecd4 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultipleLibraries/Successful/coverage.test.hs @@ -0,0 +1,7 @@ +import Test.Cabal.Prelude +main = cabalTest $ do + -- #8609 + expectBroken 8609 $ + cabal' "v2-test" ["--enable-coverage", "all"] + + return () 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/Project/CoverageProject/cabal.out b/cabal-testsuite/PackageTests/Project/CoverageProject/cabal.out new file mode 100644 index 00000000000..9106a022f1c --- /dev/null +++ b/cabal-testsuite/PackageTests/Project/CoverageProject/cabal.out @@ -0,0 +1,21 @@ +# cabal test +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - pkg-a-0.1 (lib) (first run) + - pkg-a-0.1 (test:testing) (first run) +Configuring library for pkg-a-0.1... +Warning: Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' must specify the 'default-language' field for each component (e.g. Haskell98 or Haskell2010). If a component uses different languages in different modules then list the other ones in the 'other-languages' field. +Preprocessing library for pkg-a-0.1... +Building library for pkg-a-0.1... +Configuring test suite 'testing' for pkg-a-0.1... +Warning: Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' must specify the 'default-language' field for each component (e.g. Haskell98 or Haskell2010). If a component uses different languages in different modules then list the other ones in the 'other-languages' field. +Preprocessing test suite 'testing' for pkg-a-0.1... +Building test suite 'testing' for pkg-a-0.1... +Running 1 test suites... +Test suite testing: RUNNING... +Test suite testing: PASS +Test suite logged to: /cabal.dist/work/./dist/build//ghc-/pkg-a-0.1/t/testing/test/pkg-a-0.1-testing.log +Package coverage report written to /cabal.dist/work/./dist/build//ghc-/pkg-a-0.1/t/testing/hpc/vanilla/html/hpc_index.html +1 of 1 test suites (1 of 1 test cases) passed. +Package coverage report written to /cabal.dist/work/./dist/build//ghc-/pkg-a-0.1/t/testing/hpc/vanilla/html/hpc_index.html diff --git a/cabal-testsuite/PackageTests/Project/CoverageProject/cabal.project b/cabal-testsuite/PackageTests/Project/CoverageProject/cabal.project new file mode 100644 index 00000000000..180d5248b39 --- /dev/null +++ b/cabal-testsuite/PackageTests/Project/CoverageProject/cabal.project @@ -0,0 +1 @@ +packages: pkg-a diff --git a/cabal-testsuite/PackageTests/Project/CoverageProject/cabal.test.hs b/cabal-testsuite/PackageTests/Project/CoverageProject/cabal.test.hs new file mode 100644 index 00000000000..2ddbd37916f --- /dev/null +++ b/cabal-testsuite/PackageTests/Project/CoverageProject/cabal.test.hs @@ -0,0 +1,4 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + cabal "test" ["--enable-coverage", "testing"] diff --git a/cabal-testsuite/PackageTests/Project/CoverageProject/pkg-a/Lib.hs b/cabal-testsuite/PackageTests/Project/CoverageProject/pkg-a/Lib.hs new file mode 100644 index 00000000000..bc776e49d1d --- /dev/null +++ b/cabal-testsuite/PackageTests/Project/CoverageProject/pkg-a/Lib.hs @@ -0,0 +1,3 @@ +module Lib where + +lib = "lib" diff --git a/cabal-testsuite/PackageTests/Project/CoverageProject/pkg-a/pkg-a.cabal b/cabal-testsuite/PackageTests/Project/CoverageProject/pkg-a/pkg-a.cabal new file mode 100644 index 00000000000..4a064d3389c --- /dev/null +++ b/cabal-testsuite/PackageTests/Project/CoverageProject/pkg-a/pkg-a.cabal @@ -0,0 +1,23 @@ +cabal-version: 3.0 + +name: pkg-a +version: 0.1 +build-type: Simple +category: Test +maintainer: Joe +synopsis: Test input +description: Test input +license: BSD-3-Clause + +library + build-depends: base + default-language: Haskell2010 + exposed-modules: Lib + hs-source-dirs: . + +test-suite testing + type: exitcode-stdio-1.0 + build-depends: base, pkg-a + main-is: Main.hs + hs-source-dirs: test + diff --git a/cabal-testsuite/PackageTests/Project/CoverageProject/pkg-a/test/Main.hs b/cabal-testsuite/PackageTests/Project/CoverageProject/pkg-a/test/Main.hs new file mode 100644 index 00000000000..6ee3fb933aa --- /dev/null +++ b/cabal-testsuite/PackageTests/Project/CoverageProject/pkg-a/test/Main.hs @@ -0,0 +1,2 @@ +import Lib +main = putStrLn lib 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.out b/cabal-testsuite/PackageTests/Regression/T4798/cabal.out new file mode 100644 index 00000000000..05de54b124c --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T4798/cabal.out @@ -0,0 +1,19 @@ +# cabal test +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - T4798-0.1 (lib) (first run) + - T4798-0.1 (test:hspec-suite) (first run) +Configuring library for T4798-0.1... +Preprocessing library for T4798-0.1... +Building library for T4798-0.1... +Configuring test suite 'hspec-suite' for T4798-0.1... +Preprocessing test suite 'hspec-suite' for T4798-0.1... +Building test suite 'hspec-suite' for T4798-0.1... +Running 1 test suites... +Test suite hspec-suite: RUNNING... +Test suite hspec-suite: PASS +Test suite logged to: /cabal.dist/work/./dist/build//ghc-/T4798-0.1/t/hspec-suite/test/T4798-0.1-hspec-suite.log +Package coverage report written to /cabal.dist/work/./dist/build//ghc-/T4798-0.1/t/hspec-suite/hpc/vanilla/html/hpc_index.html +1 of 1 test suites (1 of 1 test cases) passed. +Package coverage report written to /cabal.dist/work/./dist/build//ghc-/T4798-0.1/t/hspec-suite/hpc/vanilla/html/hpc_index.html 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/T5213/cabal.out b/cabal-testsuite/PackageTests/Regression/T5213/cabal.out index b713ff1904f..fb0e7ad7a9a 100644 --- a/cabal-testsuite/PackageTests/Regression/T5213/cabal.out +++ b/cabal-testsuite/PackageTests/Regression/T5213/cabal.out @@ -14,6 +14,6 @@ Running 1 test suites... Test suite tests: RUNNING... Test suite tests: PASS Test suite logged to: /cabal.dist/work/./dist/build//ghc-/cabal-gh5213-0.1/t/tests/test/cabal-gh5213-0.1-tests.log -Test coverage report written to /cabal.dist/work/./dist/build//ghc-/cabal-gh5213-0.1/t/tests/hpc/vanilla/html/tests/hpc_index.html +Package coverage report written to /cabal.dist/work/./dist/build//ghc-/cabal-gh5213-0.1/t/tests/hpc/vanilla/html/hpc_index.html 1 of 1 test suites (1 of 1 test cases) passed. -Package coverage report written to /cabal.dist/work/./dist/build//ghc-/cabal-gh5213-0.1/t/tests/hpc/vanilla/html/cabal-gh5213-0.1/hpc_index.html +Package coverage report written to /cabal.dist/work/./dist/build//ghc-/cabal-gh5213-0.1/t/tests/hpc/vanilla/html/hpc_index.html diff --git a/cabal-testsuite/PackageTests/Regression/T5213ExeCoverage/cabal.out b/cabal-testsuite/PackageTests/Regression/T5213ExeCoverage/cabal.out index ddf36d02ef5..57cb186d882 100644 --- a/cabal-testsuite/PackageTests/Regression/T5213ExeCoverage/cabal.out +++ b/cabal-testsuite/PackageTests/Regression/T5213ExeCoverage/cabal.out @@ -14,6 +14,6 @@ Running 1 test suites... Test suite tests: RUNNING... Test suite tests: PASS Test suite logged to: /cabal.dist/work/./dist/build//ghc-/cabal-gh5213-0.1/t/tests/noopt/test/cabal-gh5213-0.1-tests.log -Test coverage report written to /cabal.dist/work/./dist/build//ghc-/cabal-gh5213-0.1/t/tests/noopt/hpc/vanilla/html/tests/hpc_index.html +Package coverage report written to /cabal.dist/work/./dist/build//ghc-/cabal-gh5213-0.1/t/tests/noopt/hpc/vanilla/html/hpc_index.html 1 of 1 test suites (1 of 1 test cases) passed. -Package coverage report written to /cabal.dist/work/./dist/build//ghc-/cabal-gh5213-0.1/t/tests/noopt/hpc/vanilla/html/cabal-gh5213-0.1/hpc_index.html +Package coverage report written to /cabal.dist/work/./dist/build//ghc-/cabal-gh5213-0.1/t/tests/noopt/hpc/vanilla/html/hpc_index.html diff --git a/cabal-testsuite/PackageTests/Regression/T6440/cabal.out b/cabal-testsuite/PackageTests/Regression/T6440/cabal.out new file mode 100644 index 00000000000..80ae3cc4481 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T6440/cabal.out @@ -0,0 +1,26 @@ +# cabal test +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - cabal6440-0.1 (lib:intern6440) (first run) + - cabal6440-0.1 (lib) (first run) + - cabal6440-0.1 (test:tests) (first run) +Configuring library 'intern6440' for cabal6440-0.1... +Warning: Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' must specify the 'default-language' field for each component (e.g. Haskell98 or Haskell2010). If a component uses different languages in different modules then list the other ones in the 'other-languages' field. +Preprocessing library 'intern6440' for cabal6440-0.1... +Building library 'intern6440' for cabal6440-0.1... +Configuring library for cabal6440-0.1... +Warning: Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' must specify the 'default-language' field for each component (e.g. Haskell98 or Haskell2010). If a component uses different languages in different modules then list the other ones in the 'other-languages' field. +Preprocessing library for cabal6440-0.1... +Building library for cabal6440-0.1... +Configuring test suite 'tests' for cabal6440-0.1... +Warning: Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' must specify the 'default-language' field for each component (e.g. Haskell98 or Haskell2010). If a component uses different languages in different modules then list the other ones in the 'other-languages' field. +Preprocessing test suite 'tests' for cabal6440-0.1... +Building test suite 'tests' for cabal6440-0.1... +Running 1 test suites... +Test suite tests: RUNNING... +Test suite tests: PASS +Test suite logged to: /cabal.dist/work/./dist/build//ghc-/cabal6440-0.1/t/tests/test/cabal6440-0.1-tests.log +Package coverage report written to /cabal.dist/work/./dist/build//ghc-/cabal6440-0.1/t/tests/hpc/vanilla/html/hpc_index.html +1 of 1 test suites (1 of 1 test cases) passed. +Package coverage report written to /cabal.dist/work/./dist/build//ghc-/cabal6440-0.1/t/tests/hpc/vanilla/html/hpc_index.html 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/coverage.out b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/coverage.out new file mode 100644 index 00000000000..872dbd57eaf --- /dev/null +++ b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/coverage.out @@ -0,0 +1,30 @@ +# cabal v2-test +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - my-0.1 (lib) (first run) + - my-0.1 (test:test-Short) (first run) + - my-0.1 (test:test-Foo) (first run) +Configuring library for my-0.1... +Preprocessing library for my-0.1... +Building library for my-0.1... +Configuring test suite 'test-Short' for my-0.1... +Preprocessing test suite 'test-Short' for my-0.1... +Building test suite 'test-Short' for my-0.1... +Running 1 test suites... +Test suite test-Short: RUNNING... +Test suite test-Short: PASS +Test suite logged to: /coverage.dist/work/./dist/build//ghc-/my-0.1/t/test-Short/test/my-0.1-test-Short.log +Package coverage report written to /coverage.dist/work/./dist/build//ghc-/my-0.1/t/test-Short/hpc/vanilla/html/hpc_index.html +1 of 1 test suites (1 of 1 test cases) passed. +Package coverage report written to /coverage.dist/work/./dist/build//ghc-/my-0.1/t/test-Short/hpc/vanilla/html/hpc_index.html +Configuring test suite 'test-Foo' for my-0.1... +Preprocessing test suite 'test-Foo' for my-0.1... +Building test suite 'test-Foo' for my-0.1... +Running 1 test suites... +Test suite test-Foo: RUNNING... +Test suite test-Foo: PASS +Test suite logged to: /coverage.dist/work/./dist/build//ghc-/my-0.1/t/test-Foo/test/my-0.1-test-Foo.log +Package coverage report written to /coverage.dist/work/./dist/build//ghc-/my-0.1/t/test-Foo/hpc/vanilla/html/hpc_index.html +1 of 1 test suites (1 of 1 test cases) passed. +Package coverage report written to /coverage.dist/work/./dist/build//ghc-/my-0.1/t/test-Foo/hpc/vanilla/html/hpc_index.html diff --git a/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/coverage.test.hs b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/coverage.test.hs new file mode 100644 index 00000000000..1348cd02f35 --- /dev/null +++ b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/coverage.test.hs @@ -0,0 +1,4 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + cabal "v2-test" ["--enable-coverage"] 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