diff --git a/Trace/Hpc/Mix.hs b/Trace/Hpc/Mix.hs --- a/Trace/Hpc/Mix.hs +++ b/Trace/Hpc/Mix.hs @@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} -#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__ >= 709 +{-# LANGUAGE Safe #-} +#elif __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-} #endif --------------------------------------------------------------- @@ -21,10 +23,12 @@ where import Data.Maybe (catMaybes) -import Data.Time +import Data.Time (UTCTime) import Data.Tree import Data.Char +import System.FilePath + -- a module index records the attributes of each tick-box that has -- been introduced in that module, accessed by tick-number position -- in the list @@ -35,7 +39,7 @@ -- | 'Mix' is the information about a modules static properties, like -- location of Tix's in a file. -- --- Tab stops are the size of a tab in the provided /line:colunm/ values. +-- Tab stops are the size of a tab in the provided /line:column/ values. -- -- * In GHC, this is 1 (a tab is just a character) -- * With @hpc-tracer@, this is 8 (a tab represents several spaces). @@ -45,7 +49,7 @@ Hash -- hash of mix entry + timestamp Int -- tab stop value. [MixEntry] -- entries - deriving (Show,Read) + deriving (Show,Read,Eq) type MixEntry = (HpcPos, BoxLabel) @@ -100,12 +104,16 @@ | dirName <- dirNames ] case catMaybes res of - [r] -> return r - xs@(_:_) -> error $ "found " ++ show(length xs) ++ " instances of " ++ modName ++ " in " ++ show dirNames - _ -> error $ "can not find " ++ modName ++ " in " ++ show dirNames + xs@(x:_:_) | any (/= x) (tail xs) -> + -- Only complain if multiple *different* `Mix` files with the + -- same name are found (#9619). + error $ "found " ++ show(length xs) ++ " different instances of " + ++ modName ++ " in " ++ show dirNames + (x:_) -> return x + _ -> error $ "can not find " ++ modName ++ " in " ++ show dirNames mixName :: FilePath -> String -> String -mixName dirName name = dirName ++ "/" ++ name ++ ".mix" +mixName dirName name = dirName name <.> "mix" ------------------------------------------------------------------------------ diff --git a/Trace/Hpc/Reflect.hsc b/Trace/Hpc/Reflect.hsc --- a/Trace/Hpc/Reflect.hsc +++ b/Trace/Hpc/Reflect.hsc @@ -15,7 +15,7 @@ import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable ( Storable(..) ) -import Data.Word +import Data.Word import Trace.Hpc.Util import System.IO.Unsafe @@ -25,10 +25,10 @@ modInfo :: [ModuleInfo] modInfo = unsafePerformIO $ do - ptr <- hs_hpc_rootModule + ptr <- hs_hpc_rootModule moduleInfoList ptr -data ModuleInfo = ModuleInfo String Word32 Hash (Ptr Word64) +data ModuleInfo = ModuleInfo String Word32 Hash (Ptr Word64) moduleInfoList :: Ptr () -> IO [ModuleInfo] moduleInfoList ptr @@ -39,42 +39,41 @@ tickCount <- (#peek HpcModuleInfo, tickCount) ptr hashNo <- (#peek HpcModuleInfo, hashNo) ptr tixArr <- (#peek HpcModuleInfo, tixArr) ptr - next <- (#peek HpcModuleInfo, next) ptr + next <- (#peek HpcModuleInfo, next) ptr rest <- moduleInfoList next return $ ModuleInfo modName tickCount (toHash (hashNo :: Int)) tixArr : rest clearTix :: IO () clearTix = do sequence_ [ pokeArray ptr $ take (fromIntegral count) $ repeat 0 - | ModuleInfo _mod count _hash ptr <- modInfo - ] + | ModuleInfo _mod count _hash ptr <- modInfo + ] return () examineTix :: IO Tix examineTix = do mods <- sequence [ do tixs <- peekArray (fromIntegral count) ptr - return $ TixModule mod' hash (fromIntegral count) - $ map fromIntegral tixs - | (ModuleInfo mod' count hash ptr) <- modInfo - ] + return $ TixModule mod' hash (fromIntegral count) + $ map fromIntegral tixs + | (ModuleInfo mod' count hash ptr) <- modInfo + ] return $ Tix mods --- requirement that the tix be of the same shape as the +-- requirement that the tix be of the same shape as the -- internal tix. updateTix :: Tix -> IO () -updateTix (Tix modTixes) +updateTix (Tix modTixes) | length modTixes /= length modInfo = error "updateTix failed" | otherwise = do sequence_ [ pokeArray ptr $ map fromIntegral tixs - | (ModuleInfo mod1 count1 hash1 ptr, - TixModule mod2 hash2 count2 tixs) <- zip modInfo modTixes - , if mod1 /= mod2 - || (fromIntegral count1) /= count2 - || hash1 /= hash2 - || length tixs /= count2 - then error "updateTix failed" - else True - ] + | (ModuleInfo mod1 count1 hash1 ptr, + TixModule mod2 hash2 count2 tixs) <- zip modInfo modTixes + , if mod1 /= mod2 + || (fromIntegral count1) /= count2 + || hash1 /= hash2 + || length tixs /= count2 + then error "updateTix failed" + else True + ] return () - diff --git a/Trace/Hpc/Tix.hs b/Trace/Hpc/Tix.hs --- a/Trace/Hpc/Tix.hs +++ b/Trace/Hpc/Tix.hs @@ -1,6 +1,10 @@ {-# LANGUAGE CPP #-} -#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} +#elif __GLASGOW_HASKELL__ >= 702 +-- System.FilePath in filepath version 1.2.0.1 isn't marked or implied Safe, +-- as shipped with GHC 7.2. +{-# LANGUAGE Trustworthy #-} #endif ------------------------------------------------------------ -- Andy Gill and Colin Runciman, June 2006 @@ -12,10 +16,11 @@ tixModuleName, tixModuleHash, tixModuleTixs, readTix, writeTix, getTixFileName) where -import Data.List (isSuffixOf) +import System.FilePath (replaceExtension) + import Trace.Hpc.Util (Hash, catchIO) --- | 'Tix' is the storage format for our dynamic imformation about +-- | 'Tix' is the storage format for our dynamic information about -- what boxes are ticked. data Tix = Tix [TixModule] deriving (Read, Show, Eq) @@ -52,15 +57,7 @@ writeTix name tix = writeFile name (show tix) -{- -tixName :: String -> String -tixName name = name ++ ".tix" --} - -- | 'getTixFullName' takes a binary or @.tix@-file name, -- and normalizes it into a @.tix@-file name. getTixFileName :: String -> String -getTixFileName str | ".tix" `isSuffixOf` str - = str - | otherwise - = str ++ ".tix" +getTixFileName str = replaceExtension str "tix" diff --git a/Trace/Hpc/Util.hs b/Trace/Hpc/Util.hs --- a/Trace/Hpc/Util.hs +++ b/Trace/Hpc/Util.hs @@ -27,11 +27,11 @@ -- | 'HpcPos' is an Hpc local rendition of a Span. data HpcPos = P !Int !Int !Int !Int deriving (Eq, Ord) --- | 'fromHpcPos' explodes the HpcPos into /line:column/-/line:colunm/ +-- | 'fromHpcPos' explodes the HpcPos into /line:column/-/line:column/ fromHpcPos :: HpcPos -> (Int,Int,Int,Int) fromHpcPos (P l1 c1 l2 c2) = (l1,c1,l2,c2) --- | 'toHpcPos' implodes to HpcPos, from /line:column/-/line:colunm/ +-- | 'toHpcPos' implodes to HpcPos, from /line:column/-/line:column/ toHpcPos :: (Int,Int,Int,Int) -> HpcPos toHpcPos (l1,c1,l2,c2) = P l1 c1 l2 c2 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,11 @@ # Changelog for [`hpc` package](http://hackage.haskell.org/package/hpc) +## 0.6.0.2 *Mar 2015* + + * Bundled with GHC 7.10.1 + + * Allow same `Mix` file in different dirs (#9619) + ## 0.6.0.1 *Mar 2014* * Bundled with GHC 7.8.1 diff --git a/hpc.cabal b/hpc.cabal --- a/hpc.cabal +++ b/hpc.cabal @@ -1,10 +1,10 @@ name: hpc -version: 0.6.0.1 --- GHC 7.6.1 released with 0.6.0.0 +version: 0.6.0.2 +-- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE author: Andy Gill -maintainer: libraries@haskell.org +maintainer: ghc-devs@haskell.org bug-reports: http://ghc.haskell.org/trac/ghc/newticket?component=Code%20Coverage category: Control synopsis: Code Coverage Library for Haskell @@ -24,11 +24,6 @@ type: git location: http://git.haskell.org/packages/hpc.git -source-repository this - type: git - location: http://git.haskell.org/packages/hpc.git - tag: hpc-0.6.0.1-release - Library default-language: Haskell98 other-extensions: CPP @@ -40,8 +35,9 @@ Trace.Hpc.Reflect Build-Depends: - base >= 4.4.1 && < 4.8, + base >= 4.4.1 && < 4.9, containers >= 0.4.1 && < 0.6, directory >= 1.1 && < 1.3, - time >= 1.2 && < 1.5 + filepath >= 1 && < 1.5, + time >= 1.2 && < 1.6 ghc-options: -Wall