Fix test --enable-coverage for multi-package projects

Cabal/src/Distribution/Simple/Hpc.hs

@@ -29,10 +29,13 @@ import Distribution.Compat.Prelude
 
 import Distribution.Types.UnqualComponentName
 import Distribution.ModuleName ( main )
+import qualified Distribution.PackageDescription as PD
 import Distribution.PackageDescription
-    ( TestSuite(..)
+    ( Library(..)
+    , TestSuite(..)
     , testModules
     )
+import Distribution.Pretty
 import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
 import Distribution.Simple.Program
     ( hpcProgram
@@ -100,8 +103,9 @@ markupTest :: Verbosity
            -> FilePath     -- ^ \"dist/\" prefix
            -> String       -- ^ Library name
            -> TestSuite
+           -> Library
            -> IO ()
-markupTest verbosity lbi distPref libName suite = do
+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
@@ -112,38 +116,40 @@ markupTest verbosity lbi distPref libName suite = do
         markup hpc hpcVer verbosity
             (tixFilePath distPref way testName') mixDirs
             htmlDir_
-            (testModules suite ++ [ main ])
+            (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', libName ]
+    mixDirs = map (mixDir distPref way) [ testName', libraryName ]
 
 -- | Generate the HTML markup for all of a package's test suites.
 markupPackage :: Verbosity
               -> LocalBuildInfo
               -> FilePath       -- ^ \"dist/\" prefix
-              -> String         -- ^ Library name
+              -> PD.PackageDescription
               -> [TestSuite]
               -> IO ()
-markupPackage verbosity lbi distPref libName suites = do
+markupPackage verbosity lbi distPref pkg_descr suites = do
     let tixFiles = map (tixFilePath distPref way) testNames
     tixFilesExist <- traverse doesFileExist tixFiles
     when (and tixFilesExist) $ 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 outFile = tixFilePath distPref way libName
-            htmlDir' = htmlDir distPref way libName
+        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' excluded
+        markup hpc hpcVer verbosity outFile mixDirs htmlDir' included
         notice verbosity $ "Package coverage report written to "
                            ++ htmlDir' </> "hpc_index.html"
   where
     way = guessWay lbi
     testNames = fmap (unUnqualComponentName . testName) suites
-    mixDirs = map (mixDir distPref way) $ libName : testNames
+    mixDirs = map (mixDir distPref way) $ libraryName : testNames
+    included = concatMap (exposedModules) $ PD.allLibraries pkg_descr
+    libraryName = prettyShow $ PD.package pkg_descr

Cabal/src/Distribution/Simple/Program/Hpc.hs

@@ -42,9 +42,9 @@ markup :: ConfiguredProgram
        -> FilePath            -- ^ Path to .tix file
        -> [FilePath]          -- ^ Paths to .mix file directories
        -> FilePath            -- ^ Path where html output should be located
-       -> [ModuleName]        -- ^ List of modules to exclude from report
+       -> [ModuleName]        -- ^ List of modules to include in the report
        -> IO ()
-markup hpc hpcVer verbosity tixFile hpcDirs destDir excluded = do
+markup hpc hpcVer verbosity tixFile hpcDirs destDir included = do
     hpcDirs' <- if withinRange hpcVer (orLaterVersion version07)
         then return hpcDirs
         else do
@@ -63,7 +63,7 @@ markup hpc hpcVer verbosity tixFile hpcDirs destDir excluded = do
     hpcDirs'' <- traverse makeRelativeToCurrentDirectory hpcDirs'
 
     runProgramInvocation verbosity
-      (markupInvocation hpc tixFile hpcDirs'' destDir excluded)
+      (markupInvocation hpc tixFile hpcDirs'' destDir included)
   where
     version07 = mkVersion [0, 7]
     (passedDirs, droppedDirs) = splitAt 1 hpcDirs
@@ -73,16 +73,15 @@ markupInvocation :: ConfiguredProgram
                  -> [FilePath]          -- ^ Paths to .mix file directories
                  -> FilePath            -- ^ Path where html output should be
                                         -- located
-                 -> [ModuleName]        -- ^ List of modules to exclude from
-                                        -- report
+                 -> [ModuleName]        -- ^ List of modules to include
                  -> ProgramInvocation
-markupInvocation hpc tixFile hpcDirs destDir excluded =
+markupInvocation hpc tixFile hpcDirs destDir included =
     let args = [ "markup", tixFile
                , "--destdir=" ++ destDir
                ]
             ++ map ("--hpcdir=" ++) hpcDirs
-            ++ ["--exclude=" ++ prettyShow moduleName
-               | moduleName <- excluded ]
+            ++ ["--include=" ++ prettyShow moduleName
+               | moduleName <- included ]
     in programInvocation hpc args
 
 union :: ConfiguredProgram

Cabal/src/Distribution/Simple/Test.hs

@@ -119,7 +119,7 @@ test args pkg_descr lbi flags = do
     writeFile packageLogFile $ show packageLog
 
     when (LBI.testCoverage lbi) $
-        markupPackage verbosity lbi distPref (prettyShow $ PD.package pkg_descr) $
+        markupPackage verbosity lbi distPref pkg_descr $
             map (fst . fst) testsToRun
 
     unless allOk exitFailure

Cabal/src/Distribution/Simple/Test/ExeV10.hs

@@ -142,7 +142,12 @@ runTest pkg_descr lbi clbi flags suite = do
     notice verbosity $ summarizeSuiteFinish suiteLog
 
     when isCoverageEnabled $
-        markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite
+        case PD.library pkg_descr of
+            Nothing ->
+                die' verbosity $ "Error: test coverage is only supported for packages with a library component"
+
+            Just library ->
+                markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite library
 
     return suiteLog
   where

Cabal/src/Distribution/Simple/Test/LibV09.hs

@@ -158,7 +158,12 @@ runTest pkg_descr lbi clbi flags suite = do
     notice verbosity $ summarizeSuiteFinish suiteLog
 
     when isCoverageEnabled $
-        markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite
+        case PD.library pkg_descr of
+            Nothing ->
+                die' verbosity $ "Error: test coverage is only supported for packages with a library component"
+
+            Just library ->
+                markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite library
 
     return suiteLog
   where