summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorandy@galois.com <unknown>2007-07-11 07:05:55 +0000
committerandy@galois.com <unknown>2007-07-11 07:05:55 +0000
commit53ebe8abd4f307200f8f513e0ebb11f4d0cd14d9 (patch)
treeca6f5477c3ab449bb97062718c24bac75882083a
parent6758ba711a3f9f3100a9dba1818b131c32e62106 (diff)
downloadhaskell-53ebe8abd4f307200f8f513e0ebb11f4d0cd14d9.tar.gz
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.
-rw-r--r--compiler/codeGen/CgHpc.hs10
-rw-r--r--compiler/deSugar/Coverage.lhs10
2 files changed, 15 insertions, 5 deletions
diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs
index 0aa011d11b..ed58daaac0 100644
--- 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 a9b1a528e4..8d9090073c 100644
--- 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