Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/4e4c2976decf52d808faab72ca2103c78c50ad2f >--------------------------------------------------------------- commit 4e4c2976decf52d808faab72ca2103c78c50ad2f Author: Thomas Tuegel <[email protected]> Date: Mon Jul 18 05:04:48 2011 +0000 Generate aggregate coverage statistics from all test suites in package. >--------------------------------------------------------------- cabal/Distribution/Simple/Hpc.hs | 52 +++++++++++++++++++++++++++++-------- cabal/Distribution/Simple/Test.hs | 14 +++++++--- 2 files changed, 51 insertions(+), 15 deletions(-) diff --git a/cabal/Distribution/Simple/Hpc.hs b/cabal/Distribution/Simple/Hpc.hs index d6c4f3c..b579d16 100644 --- a/cabal/Distribution/Simple/Hpc.hs +++ b/cabal/Distribution/Simple/Hpc.hs @@ -42,8 +42,10 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.Hpc ( enableCoverage + , htmlDir , tixDir , tixFilePath + , markupPackage , markupTest ) where @@ -59,11 +61,11 @@ import Distribution.PackageDescription ) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) ) import Distribution.Simple.Program ( hpcProgram, requireProgram ) -import Distribution.Simple.Program.Hpc ( markup ) +import Distribution.Simple.Program.Hpc ( markup, union ) import Distribution.Simple.Utils ( notice ) import Distribution.Text import Distribution.Verbosity ( Verbosity() ) -import System.Directory ( doesFileExist ) +import System.Directory ( createDirectoryIfMissing, doesFileExist ) import System.FilePath -- ------------------------------------------------------------------------- @@ -111,15 +113,20 @@ mixDir :: FilePath -- ^ \"dist/\" prefix mixDir distPref name = hpcDir distPref </> "mix" </> name tixDir :: FilePath -- ^ \"dist/\" prefix - -> TestSuite -- ^ Test suite + -> FilePath -- ^ Component name -> FilePath -- ^ Directory containing test suite's .tix files -tixDir distPref suite = hpcDir distPref </> "tix" </> testName suite +tixDir distPref name = hpcDir distPref </> "tix" </> name -- | Path to the .tix file containing a test suite's sum statistics. tixFilePath :: FilePath -- ^ \"dist/\" prefix - -> TestSuite -- ^ Test suite - -> FilePath -- Path to test suite's .tix file -tixFilePath distPref suite = tixDir distPref suite </> testName suite <.> "tix" + -> FilePath -- ^ Component name + -> FilePath -- ^ Path to test suite's .tix file +tixFilePath distPref name = tixDir distPref name </> name <.> "tix" + +htmlDir :: FilePath -- ^ \"dist/\" prefix + -> FilePath -- ^ Component name + -> FilePath -- ^ Path to test suite's HTML markup directory +htmlDir distPref name = hpcDir distPref </> "html" </> name -- | Generate the HTML markup for a test suite. markupTest :: Verbosity @@ -129,12 +136,35 @@ markupTest :: Verbosity -> TestSuite -> IO () markupTest verbosity lbi distPref libName suite = do - tixFileExists <- doesFileExist $ tixFilePath distPref suite + tixFileExists <- doesFileExist $ tixFilePath distPref $ testName suite when tixFileExists $ do (hpc, _) <- requireProgram verbosity hpcProgram $ withPrograms lbi - markup hpc verbosity (tixFilePath distPref suite) + markup hpc verbosity (tixFilePath distPref $ testName suite) (mixDir distPref libName) - (htmlDir distPref suite) + (htmlDir distPref $ testName suite) (testModules suite ++ [ main ]) notice verbosity $ "Test coverage report written to " - ++ htmlDir distPref suite </> "hpc_index" <.> "html" + ++ htmlDir distPref (testName suite) + </> "hpc_index" <.> "html" + +-- | Generate the HTML markup for all of a package's test suites. +markupPackage :: Verbosity + -> LocalBuildInfo + -> FilePath -- ^ \"dist/\" prefix + -> String -- ^ Library name + -> [TestSuite] + -> IO () +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 + 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 + notice verbosity $ "Package coverage report written to " + ++ htmlDir' </> "hpc_index.html" diff --git a/cabal/Distribution/Simple/Test.hs b/cabal/Distribution/Simple/Test.hs index bc62e80..3476e44 100644 --- a/cabal/Distribution/Simple/Test.hs +++ b/cabal/Distribution/Simple/Test.hs @@ -63,7 +63,8 @@ import qualified Distribution.PackageDescription as PD import Distribution.Simple.Build.PathsModule ( pkgPathEnvVar ) import Distribution.Simple.BuildPaths ( exeExtension ) import Distribution.Simple.Compiler ( Compiler(..), CompilerId ) -import Distribution.Simple.Hpc ( markupTest, tixDir, tixFilePath ) +import Distribution.Simple.Hpc + ( markupPackage, markupTest, tixDir, tixFilePath ) import Distribution.Simple.InstallDirs ( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..) , substPathTemplate , toPathTemplate, PathTemplate ) @@ -175,7 +176,8 @@ testController flags pkg_descr lbi suite preTest cmd postTest logNamer = do existingEnv <- getEnvironment let dataDirPath = pwd </> PD.dataDir pkg_descr shellEnv = Just $ (pkgPathEnvVar pkg_descr "datadir", dataDirPath) - : ("HPCTIXFILE", pwd </> tixFilePath distPref suite) + : ("HPCTIXFILE", (</>) pwd + $ tixFilePath distPref $ PD.testName suite) : existingEnv bracket (openCabalTemp testLogDir) deleteIfExists $ \tempLog -> @@ -183,12 +185,12 @@ testController flags pkg_descr lbi suite preTest cmd postTest logNamer = do -- Remove old .tix files if appropriate. unless (fromFlag $ testKeepTix flags) $ do - let tDir = tixDir distPref suite + let tDir = tixDir distPref $ PD.testName suite exists <- doesDirectoryExist tDir when exists $ removeDirectoryRecursive tDir -- Create directory for HPC files. - createDirectoryIfMissing True $ tixDir distPref suite + createDirectoryIfMissing True $ tixDir distPref $ PD.testName suite -- Write summary notices indicating start of test suite notice verbosity $ summarizeSuiteStart $ PD.testName suite @@ -347,6 +349,10 @@ test pkg_descr lbi flags = do $ packageLogPath machineTemplate pkg_descr lbi allOk <- summarizePackage verbosity packageLog writeFile packageLogFile $ show packageLog + + markupPackage verbosity lbi distPref (display $ PD.package pkg_descr) + $ map fst testsToRun + unless allOk exitFailure -- | Print a summary to the console after all test suites have been run _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
