Merge pull request #1155 from benmachine/hpcmsg

Improve warning for old versions of HPC

Cabal/Distribution/Simple/Hpc.hs

@@ -62,10 +62,11 @@ import Distribution.PackageDescription
 import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
 import Distribution.Simple.Program
     ( hpcProgram
-    , requireProgram
+    , requireProgramVersion
     )
 import Distribution.Simple.Program.Hpc ( markup, union )
 import Distribution.Simple.Utils ( notice )
+import Distribution.Version ( anyVersion )
 import Distribution.Text
 import Distribution.Verbosity ( Verbosity() )
 import System.Directory ( createDirectoryIfMissing, doesFileExist )
@@ -141,8 +142,11 @@ markupTest :: Verbosity
 markupTest verbosity lbi distPref libName suite = do
     tixFileExists <- doesFileExist $ tixFilePath distPref $ testName suite
     when tixFileExists $ do
-        (hpc, _) <- requireProgram verbosity hpcProgram $ withPrograms lbi
-        markup hpc verbosity
+        -- behaviour of 'markup' depends on version, so we need *a* version
+        -- but no particular one
+        (hpc, hpcVer, _) <- requireProgramVersion verbosity
+            hpcProgram anyVersion (withPrograms lbi)
+        markup hpc hpcVer verbosity
             (tixFilePath distPref $ testName suite) mixDirs
             (htmlDir distPref $ testName suite)
             (testModules suite ++ [ main ])
@@ -163,13 +167,16 @@ markupPackage verbosity lbi distPref libName suites = do
     let tixFiles = map (tixFilePath distPref . testName) suites
     tixFilesExist <- mapM doesFileExist tixFiles
     when (and tixFilesExist) $ do
-        (hpc, _) <- requireProgram verbosity hpcProgram $ withPrograms lbi
+        -- 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 libName
             htmlDir' = htmlDir distPref libName
             excluded = concatMap testModules suites ++ [ main ]
         createDirectoryIfMissing True $ takeDirectory outFile
         union hpc verbosity tixFiles outFile excluded
-        markup hpc verbosity outFile mixDirs htmlDir' excluded
+        markup hpc hpcVer verbosity outFile mixDirs htmlDir' excluded
         notice verbosity $ "Package coverage report written to "
                            ++ htmlDir' </> "hpc_index.html"
   where

Cabal/Distribution/Simple/Program/Hpc.hs

@@ -13,7 +13,6 @@ module Distribution.Simple.Program.Hpc
     , union
     ) where
 
-import Control.Monad ( unless )
 import Distribution.ModuleName ( ModuleName )
 import Distribution.Simple.Program.Run
          ( ProgramInvocation, programInvocation, runProgramInvocation )
@@ -23,29 +22,41 @@ import Distribution.Simple.Utils ( warn )
 import Distribution.Verbosity ( Verbosity )
 import Distribution.Version ( Version(..), orLaterVersion, withinRange )
 
+-- | Invoke hpc with the given parameters.
+--
+-- Prior to HPC version 0.7 (packaged with GHC 7.8), hpc did not handle
+-- multiple .mix paths correctly, so we print a warning, and only pass it the
+-- first path in the list. This means that e.g. test suites that import their
+-- library as a dependency can still work, but those that include the library
+-- modules directly (in other-modules) don't.
 markup :: ConfiguredProgram
+       -> Version
        -> Verbosity
        -> 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
        -> IO ()
-markup hpc verbosity tixFile hpcDirs destDir excluded = do
-    unless atLeastHpc07 $ warn verbosity $
-           "This version of HPC has known issues. Coverage report generation "
-        ++ "may fail unexpectedly. Please upgrade to HPC 0.7 or later "
-        ++ "(GHC 7.8 or later) as soon as possible."
-        ++ versionMsg
+markup hpc hpcVer verbosity tixFile hpcDirs destDir excluded = do
+    hpcDirs' <- if withinRange hpcVer (orLaterVersion version07)
+        then return hpcDirs
+        else do
+            warn verbosity $ "Your version of HPC (" ++ display hpcVer
+                ++ ") does not properly handle multiple search paths. "
+                ++ "Coverage report generation may fail unexpectedly. These "
+                ++ "issues are addressed in version 0.7 or later (GHC 7.8 or "
+                ++ "later)."
+                ++ if null droppedDirs
+                    then ""
+                    else " The following search paths have been abandoned: "
+                        ++ show droppedDirs
+            return passedDirs
+
     runProgramInvocation verbosity
       (markupInvocation hpc tixFile hpcDirs' destDir excluded)
   where
-    hpcDirs' | atLeastHpc07 = hpcDirs
-             | otherwise = take 1 hpcDirs
-    atLeastHpc07 = maybe False (flip withinRange $ orLaterVersion version07)
-        $ programVersion hpc
     version07 = Version { versionBranch = [0, 7], versionTags = [] }
-    versionMsg = maybe "" (\v -> " (Found HPC " ++ display v ++ ")")
-                          (programVersion hpc)
+    (passedDirs, droppedDirs) = splitAt 1 hpcDirs
 
 markupInvocation :: ConfiguredProgram
                  -> FilePath            -- ^ Path to .tix file