diff options
| author | Thomas Miedema <thomasmiedema@gmail.com> | 2015-03-17 18:09:18 +0100 |
|---|---|---|
| committer | Thomas Miedema <thomasmiedema@gmail.com> | 2015-03-17 18:17:27 +0100 |
| commit | 801f4b98fa5198ab7e033949dd84aaae00162993 (patch) | |
| tree | 4efda91a9cf063b614c47bd4cd8be44872f77469 | |
| parent | 86eff3d92ffa3c9be29e037c01fd9b3fec8976e7 (diff) | |
| download | haskell-801f4b98fa5198ab7e033949dd84aaae00162993.tar.gz | |
hpc: use System.FilePath.(</>) instead of (++)
Summary:
BAD: "." ++ "/" ++ "/absolute/path" == ".//absolute/path"
GOOD: "." </> "/absolute/path" == "/absolute path"
Also replace `++ ".ext"` with `<.> "ext"`. Although it doesn't fix any
bugs in this instance, it might in some other. As a general rule it's
better not to use (++) on FilePaths.
Reviewed By: austin, hvr
Differential Revision: https://phabricator.haskell.org/D703
GHC Trac Issues: #10138
| -rw-r--r-- | testsuite/tests/hpc/.hpc.T10138/Main.mix | 1 | ||||
| -rw-r--r-- | testsuite/tests/hpc/T10138.tix | 1 | ||||
| -rw-r--r-- | testsuite/tests/hpc/all.T | 7 | ||||
| -rw-r--r-- | utils/hpc/HpcFlags.hs | 3 | ||||
| -rw-r--r-- | utils/hpc/HpcMarkup.hs | 9 | ||||
| -rw-r--r-- | utils/hpc/HpcUtils.hs | 3 | ||||
| -rw-r--r-- | utils/hpc/hpc-bin.cabal | 1 |
7 files changed, 18 insertions, 7 deletions
diff --git a/testsuite/tests/hpc/.hpc.T10138/Main.mix b/testsuite/tests/hpc/.hpc.T10138/Main.mix new file mode 100644 index 0000000000..26611fef24 --- /dev/null +++ b/testsuite/tests/hpc/.hpc.T10138/Main.mix @@ -0,0 +1 @@ +Mix "T10138.hs" 2015-03-09 18:22:16.403500034 UTC 2143033233 8 [(1:15-1:16,ExpBox False),(1:8-1:16,ExpBox False),(1:1-1:16,TopLevelBox ["main"])] diff --git a/testsuite/tests/hpc/T10138.tix b/testsuite/tests/hpc/T10138.tix new file mode 100644 index 0000000000..f348f7089e --- /dev/null +++ b/testsuite/tests/hpc/T10138.tix @@ -0,0 +1 @@ +Tix [ TixModule "Main" 2143033233 3 [0,1,1]] diff --git a/testsuite/tests/hpc/all.T b/testsuite/tests/hpc/all.T index d279018025..0289733b50 100644 --- a/testsuite/tests/hpc/all.T +++ b/testsuite/tests/hpc/all.T @@ -1,8 +1,13 @@ +test('T10138', ignore_output, run_command, + # Using --hpcdir with an absolute path should work (exit code 0). + ['{hpc} report T10138.tix --hpcdir="`pwd`/.hpc.T10138"']) + +# Run tests below only for the hpc way. +# # Do not explicitly specify '-fhpc' in extra_hc_opts, unless 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']), ]) diff --git a/utils/hpc/HpcFlags.hs b/utils/hpc/HpcFlags.hs index 017030986a..dd1d9f7260 100644 --- a/utils/hpc/HpcFlags.hs +++ b/utils/hpc/HpcFlags.hs @@ -8,6 +8,7 @@ import Data.Char import Trace.Hpc.Tix import Trace.Hpc.Mix import System.Exit +import System.FilePath data Flags = Flags { outputFile :: String @@ -154,7 +155,7 @@ unionModuleOpt = noArg "union" ------------------------------------------------------------------------------- readMixWithFlags :: Flags -> Either String TixModule -> IO Mix -readMixWithFlags flags modu = readMix [ dir ++ "/" ++ hpcDir +readMixWithFlags flags modu = readMix [ dir </> hpcDir | dir <- srcDirs flags , hpcDir <- hpcDirs flags ] modu diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index 1373bfbee5..31327fc991 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -13,6 +13,7 @@ import HpcFlags import HpcUtils import System.Directory +import System.FilePath import System.IO (localeEncoding) import Data.List import Data.Maybe(fromJust) @@ -78,9 +79,9 @@ markup_main flags (prog:modNames) = do let mods' = sortBy cmp mods unless (verbosity flags < Normal) $ - putStrLn $ "Writing: " ++ (filename ++ ".html") + putStrLn $ "Writing: " ++ (filename <.> "html") - writeFileUsing (dest_dir ++ "/" ++ filename ++ ".html") $ + writeFileUsing (dest_dir </> filename <.> "html") $ "<html>" ++ "<head>" ++ charEncodingTag ++ @@ -224,10 +225,10 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do let content' = markup tabStop info content let addLine n xs = "<span class=\"lineno\">" ++ padLeft 5 ' ' (show n) ++ " </span>" ++ xs let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines - let fileName = modName0 ++ ".hs.html" + let fileName = modName0 <.> "hs" <.> "html" unless (verbosity flags < Normal) $ putStrLn $ "Writing: " ++ fileName - writeFileUsing (dest_dir ++ "/" ++ fileName) $ + writeFileUsing (dest_dir </> fileName) $ unlines ["<html>", "<head>", charEncodingTag, diff --git a/utils/hpc/HpcUtils.hs b/utils/hpc/HpcUtils.hs index 4f98556176..6ee44b1ae6 100644 --- a/utils/hpc/HpcUtils.hs +++ b/utils/hpc/HpcUtils.hs @@ -2,6 +2,7 @@ module HpcUtils where import Trace.Hpc.Util import qualified Data.Map as Map +import System.FilePath dropWhileEndLE :: (a -> Bool) -> [a] -> [a] -- Spec: dropWhileEndLE p = reverse . dropWhile p . reverse @@ -30,6 +31,6 @@ readFileFromPath err filename path0 = readTheFile path0 readTheFile [] = err $ "could not find " ++ show filename ++ " in path " ++ show path0 readTheFile (dir:dirs) = - catchIO (do str <- readFile (dir ++ "/" ++ filename) + catchIO (do str <- readFile (dir </> filename) return str) (\ _ -> readTheFile dirs) diff --git a/utils/hpc/hpc-bin.cabal b/utils/hpc/hpc-bin.cabal index 8ec6e5b790..0257fb99c7 100644 --- a/utils/hpc/hpc-bin.cabal +++ b/utils/hpc/hpc-bin.cabal @@ -43,6 +43,7 @@ Executable hpc if flag(base3) || flag(base4) Build-Depends: directory >= 1 && < 1.3, + filepath >= 1 && < 1.5, containers >= 0.1 && < 0.6, array >= 0.1 && < 0.6 Build-Depends: hpc |