Adding support for package names into hpc outputed code

We store .mix files in

 .hpc/<package>/<the.module.name>.mix

The package main the empty package (aka other naming passes),
so Main just is stored in

 .hpc/Main.tix

This change in backwards compatable.

diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs
index 0aa011d..ed58daa 100644 (file)
--- a/compiler/codeGen/CgHpc.hs
+++ b/compiler/codeGen/CgHpc.hs
@@ -22,6 +22,7 @@ import FastString
 import HscTypes
 import Char
 import StaticFlags
+import PackageConfig 
 
 cgTickBox :: Module -> Int -> Code
 cgTickBox mod n = do
@@ -35,15 +36,13 @@ cgTickBox mod n = do
                                                , CmmLit (CmmInt 1 I64)
                                                ])
               ] 
-   where
-      visible_tick = mkFastString "hs_hpc_tick"
 
 hpcTable :: Module -> HpcInfo -> Code
 hpcTable this_mod (HpcInfo hpc_tickCount _) = do
                         emitData ReadOnlyData
                                         [ CmmDataLabel mkHpcModuleNameLabel
                                         , CmmString $ map (fromIntegral . ord)
-                                                         (module_name_str)
+                                                         (full_name_str)
                                                       ++ [0]
                                         ]
                         emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
@@ -53,6 +52,11 @@ hpcTable this_mod (HpcInfo hpc_tickCount _) = do
                                         ]
   where
     module_name_str = moduleNameString (Module.moduleName this_mod)
+    full_name_str   = if modulePackageId this_mod == mainPackageId 
+                     then module_name_str
+                     else packageIdString (modulePackageId this_mod) ++ "/" ++
+                          module_name_str
+
 hpcTable this_mod (NoHpcInfo) = error "TODO: impossible"
 
 initHpc :: Module -> HpcInfo -> Code

diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index a9b1a52..8d90900 100644 (file)
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -28,6 +28,7 @@ import UniqFM
 import Type
 import TyCon
 import FiniteMap
+import PackageConfig 
 
 import Data.Array
 import System.Time (ClockTime(..))
@@ -91,15 +92,20 @@ addCoverageTicksToBinds dflags mod mod_loc tyCons binds = do
   -- write the mix entries for this module
   hashNo <- if opt_Hpc then do
      let hpc_dir = hpcDir dflags
+
+     let hpc_mod_dir = if modulePackageId mod == mainPackageId 
+                      then hpc_dir
+                      else hpc_dir ++ "/" ++ packageIdString (modulePackageId mod)
+
      let tabStop = 1 -- <tab> counts as a normal char in GHC's location ranges.
-     createDirectoryIfMissing True hpc_dir
+     createDirectoryIfMissing True hpc_mod_dir
      modTime <- getModificationTime orig_file
      let entries' = [ (hpcPos, box) 
                     | (span,_,box) <- entries, hpcPos <- [mkHpcPos span] ]
      when (length entries' /= tickBoxCount st) $ do
        panic "the number of .mix entries are inconsistent"
      let hashNo = mixHash orig_file modTime tabStop entries'
-     mixCreate hpc_dir mod_name 
+     mixCreate hpc_mod_dir mod_name 
               $ Mix orig_file modTime (toHash hashNo) tabStop entries'
      return $ hashNo 
    else do