Merge branch 'master' of https://github.com/ttuegel/cabal

23Skidoo · Nov 30, 2012 · 51bdff5 · 51bdff5
2 parents eb992f5 + bf2fb86
commit 51bdff5
Show file tree

Hide file tree

Showing 2 changed files with 36 additions and 14 deletions.
diff --git a/Cabal/Distribution/Simple/Hpc.hs b/Cabal/Distribution/Simple/Hpc.hs
@@ -60,7 +60,10 @@ import Distribution.PackageDescription
     , testModules
     )
 import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
-import Distribution.Simple.Program ( hpcProgram, requireProgram )
+import Distribution.Simple.Program
+    ( hpcProgram
+    , requireProgram
+    )
 import Distribution.Simple.Program.Hpc ( markup, union )
 import Distribution.Simple.Utils ( notice )
 import Distribution.Text
@@ -139,13 +142,15 @@ 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 (tixFilePath distPref $ testName suite)
-                             (mixDir distPref libName)
-                             (htmlDir distPref $ testName suite)
-                             (testModules suite ++ [ main ])
+        markup hpc verbosity
+            (tixFilePath distPref $ testName suite) mixDirs
+            (htmlDir distPref $ testName suite)
+            (testModules suite ++ [ main ])
         notice verbosity $ "Test coverage report written to "
                             ++ htmlDir distPref (testName suite)
                             </> "hpc_index" <.> "html"
+  where
+    mixDirs = map (mixDir distPref) [ testName suite, libName ]
 
 -- | Generate the HTML markup for all of a package's test suites.
 markupPackage :: Verbosity
@@ -160,11 +165,12 @@ markupPackage verbosity lbi distPref libName suites = do
     when (and tixFilesExist) $ do
         (hpc, _) <- requireProgram verbosity hpcProgram $ withPrograms lbi
         let outFile = tixFilePath distPref libName
-            mixDir' = mixDir 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 mixDir' htmlDir' excluded
+        markup hpc verbosity outFile mixDirs htmlDir' excluded
         notice verbosity $ "Package coverage report written to "
                            ++ htmlDir' </> "hpc_index.html"
+  where
+    mixDirs = map (mixDir distPref) $ libName : map testName suites
diff --git a/Cabal/Distribution/Simple/Program/Hpc.hs b/Cabal/Distribution/Simple/Program/Hpc.hs
@@ -13,37 +13,53 @@ module Distribution.Simple.Program.Hpc
     , union
     ) where
 
+import Control.Monad ( unless )
 import Distribution.ModuleName ( ModuleName )
 import Distribution.Simple.Program.Run
          ( ProgramInvocation, programInvocation, runProgramInvocation )
-import Distribution.Simple.Program.Types ( ConfiguredProgram )
+import Distribution.Simple.Program.Types ( ConfiguredProgram(..) )
 import Distribution.Text ( display )
+import Distribution.Simple.Utils ( warn )
 import Distribution.Verbosity ( Verbosity )
+import Distribution.Version ( Version(..), orLaterVersion, withinRange )
 
 markup :: ConfiguredProgram
        -> Verbosity
        -> FilePath            -- ^ Path to .tix file
-       -> FilePath            -- ^ Path to directory with .mix files
+       -> [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 hpcDir destDir excluded =
+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
     runProgramInvocation verbosity
-      (markupInvocation hpc tixFile hpcDir destDir excluded)
+      (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)
 
 markupInvocation :: ConfiguredProgram
                  -> FilePath            -- ^ Path to .tix file
-                 -> FilePath            -- ^ Path to directory with .mix files
+                 -> [FilePath]          -- ^ Paths to .mix file directories
                  -> FilePath            -- ^ Path where html output should be
                                         -- located
                  -> [ModuleName]        -- ^ List of modules to exclude from
                                         -- report
                  -> ProgramInvocation
-markupInvocation hpc tixFile hpcDir destDir excluded =
+markupInvocation hpc tixFile hpcDirs destDir excluded =
     let args = [ "markup", tixFile
-               , "--hpcdir=" ++ hpcDir
                , "--destdir=" ++ destDir
                ]
+            ++ map ("--hpcdir=" ++) hpcDirs
             ++ ["--exclude=" ++ display moduleName
                | moduleName <- excluded ]
     in programInvocation hpc args