[commit: packages/hpc] wip/T9619: Allow same `Mix` file in different dirs (#9619) (ed80343)

git at git.haskell.org git at git.haskell.org
Thu Mar 5 21:02:25 UTC 2015


Repository : ssh://git@git.haskell.org/hpc

On branch  : wip/T9619
Link       : http://git.haskell.org/packages/hpc.git/commitdiff/ed803439c303cc27632a0d47f52aab71d15c1121

>---------------------------------------------------------------

commit ed803439c303cc27632a0d47f52aab71d15c1121
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date:   Thu Mar 5 21:43:36 2015 +0100

    Allow same `Mix` file in different dirs (#9619)


>---------------------------------------------------------------

ed803439c303cc27632a0d47f52aab71d15c1121
 Trace/Hpc/Mix.hs | 10 +++++++---
 tests/T9619.hs   |  1 +
 tests/all.T      | 16 ++++++++++++++++
 3 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/Trace/Hpc/Mix.hs b/Trace/Hpc/Mix.hs
index 4a7fc74..340a800 100644
--- a/Trace/Hpc/Mix.hs
+++ b/Trace/Hpc/Mix.hs
@@ -22,6 +22,7 @@ module Trace.Hpc.Mix
         )
   where
 
+import Data.List (nub)
 import Data.Maybe (catMaybes)
 import Data.Time (UTCTime)
 import Data.Tree
@@ -49,7 +50,7 @@ data Mix = Mix
              Hash               -- hash of mix entry + timestamp
              Int                -- tab stop value.
              [MixEntry]         -- entries
-        deriving (Show,Read)
+        deriving (Show,Read,Eq)
 
 type MixEntry = (HpcPos, BoxLabel)
 
@@ -103,9 +104,12 @@ readMix dirNames mod' = do
                            _ -> return $ Nothing) `catchIO` (\ _ -> return $ Nothing)
                    | dirName <- dirNames
                    ]
-   case catMaybes res of
+   -- `nub` allows identical `Mix` files in different directories (#9619).
+   case nub (catMaybes res) of
      [r] -> return r
-     xs@(_:_) -> error $ "found " ++ show(length xs) ++ " instances of " ++ modName ++ " in " ++ show dirNames
+     xs@(_:_) -> error $ "found " ++ show(length xs) ++
+                         " different instances of " ++ modName ++
+                         " in " ++ show dirNames
      _        -> error $ "can not find " ++ modName ++ " in " ++ show dirNames
 
 mixName :: FilePath -> String -> String
diff --git a/tests/T9619.hs b/tests/T9619.hs
new file mode 100644
index 0000000..b3549c2
--- /dev/null
+++ b/tests/T9619.hs
@@ -0,0 +1 @@
+main = return ()
diff --git a/tests/all.T b/tests/all.T
new file mode 100644
index 0000000..da94fbb
--- /dev/null
+++ b/tests/all.T
@@ -0,0 +1,16 @@
+# Do not explicitly specify '-fhpc' in extra_hc_opts, without also setting
+# '-hpcdir' to a different value for each test. Only the `hpc` way does this
+# automatically. This way the tests in this directory can be run concurrently
+# (Main.mix might overlap otherwise).
+
+setTestOpts([only_compiler_types(['ghc']),
+             only_ways(['hpc']),
+             ])
+
+def T9619(cmd):
+  # Having the same mix file in two different hpcdirs should work (exit code 0).
+  return(cmd + " && cp -R .hpc.T9619 .hpc.T9619b && " +
+         "{hpc} report T9619.tix --hpcdir=.hpc.T9619 --hpcdir=.hpc.T9619b")
+test('T9619', [cmd_wrapper(T9619), ignore_output],
+               extra_clean(['.hpc.T9619b/Main.mix', '.hpc.T9619b'])],
+     compile_and_run, [''])



More information about the ghc-commits mailing list