Commit 801f4b98 authored by thomie's avatar thomie
Browse files

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
parent 86eff3d9
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"])]
Tix [ TixModule "Main" 2143033233 3 [0,1,1]]
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 # 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 # '-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 # automatically. This way the tests in this directory can be run concurrently
# (Main.mix might overlap otherwise). # (Main.mix might overlap otherwise).
setTestOpts([only_compiler_types(['ghc']), setTestOpts([only_compiler_types(['ghc']),
only_ways(['hpc']), only_ways(['hpc']),
]) ])
......
...@@ -8,6 +8,7 @@ import Data.Char ...@@ -8,6 +8,7 @@ import Data.Char
import Trace.Hpc.Tix import Trace.Hpc.Tix
import Trace.Hpc.Mix import Trace.Hpc.Mix
import System.Exit import System.Exit
import System.FilePath
data Flags = Flags data Flags = Flags
{ outputFile :: String { outputFile :: String
...@@ -154,7 +155,7 @@ unionModuleOpt = noArg "union" ...@@ -154,7 +155,7 @@ unionModuleOpt = noArg "union"
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
readMixWithFlags :: Flags -> Either String TixModule -> IO Mix readMixWithFlags :: Flags -> Either String TixModule -> IO Mix
readMixWithFlags flags modu = readMix [ dir ++ "/" ++ hpcDir readMixWithFlags flags modu = readMix [ dir </> hpcDir
| dir <- srcDirs flags | dir <- srcDirs flags
, hpcDir <- hpcDirs flags , hpcDir <- hpcDirs flags
] modu ] modu
......
...@@ -13,6 +13,7 @@ import HpcFlags ...@@ -13,6 +13,7 @@ import HpcFlags
import HpcUtils import HpcUtils
import System.Directory import System.Directory
import System.FilePath
import System.IO (localeEncoding) import System.IO (localeEncoding)
import Data.List import Data.List
import Data.Maybe(fromJust) import Data.Maybe(fromJust)
...@@ -78,9 +79,9 @@ markup_main flags (prog:modNames) = do ...@@ -78,9 +79,9 @@ markup_main flags (prog:modNames) = do
let mods' = sortBy cmp mods let mods' = sortBy cmp mods
unless (verbosity flags < Normal) $ unless (verbosity flags < Normal) $
putStrLn $ "Writing: " ++ (filename ++ ".html") putStrLn $ "Writing: " ++ (filename <.> "html")
writeFileUsing (dest_dir ++ "/" ++ filename ++ ".html") $ writeFileUsing (dest_dir </> filename <.> "html") $
"<html>" ++ "<html>" ++
"<head>" ++ "<head>" ++
charEncodingTag ++ charEncodingTag ++
...@@ -224,10 +225,10 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do ...@@ -224,10 +225,10 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
let content' = markup tabStop info content let content' = markup tabStop info content
let addLine n xs = "<span class=\"lineno\">" ++ padLeft 5 ' ' (show n) ++ " </span>" ++ xs let addLine n xs = "<span class=\"lineno\">" ++ padLeft 5 ' ' (show n) ++ " </span>" ++ xs
let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines
let fileName = modName0 ++ ".hs.html" let fileName = modName0 <.> "hs" <.> "html"
unless (verbosity flags < Normal) $ unless (verbosity flags < Normal) $
putStrLn $ "Writing: " ++ fileName putStrLn $ "Writing: " ++ fileName
writeFileUsing (dest_dir ++ "/" ++ fileName) $ writeFileUsing (dest_dir </> fileName) $
unlines ["<html>", unlines ["<html>",
"<head>", "<head>",
charEncodingTag, charEncodingTag,
......
...@@ -2,6 +2,7 @@ module HpcUtils where ...@@ -2,6 +2,7 @@ module HpcUtils where
import Trace.Hpc.Util import Trace.Hpc.Util
import qualified Data.Map as Map import qualified Data.Map as Map
import System.FilePath
dropWhileEndLE :: (a -> Bool) -> [a] -> [a] dropWhileEndLE :: (a -> Bool) -> [a] -> [a]
-- Spec: dropWhileEndLE p = reverse . dropWhile p . reverse -- Spec: dropWhileEndLE p = reverse . dropWhile p . reverse
...@@ -30,6 +31,6 @@ readFileFromPath err filename path0 = readTheFile path0 ...@@ -30,6 +31,6 @@ readFileFromPath err filename path0 = readTheFile path0
readTheFile [] = err $ "could not find " ++ show filename readTheFile [] = err $ "could not find " ++ show filename
++ " in path " ++ show path0 ++ " in path " ++ show path0
readTheFile (dir:dirs) = readTheFile (dir:dirs) =
catchIO (do str <- readFile (dir ++ "/" ++ filename) catchIO (do str <- readFile (dir </> filename)
return str) return str)
(\ _ -> readTheFile dirs) (\ _ -> readTheFile dirs)
...@@ -43,6 +43,7 @@ Executable hpc ...@@ -43,6 +43,7 @@ Executable hpc
if flag(base3) || flag(base4) if flag(base3) || flag(base4)
Build-Depends: directory >= 1 && < 1.3, Build-Depends: directory >= 1 && < 1.3,
filepath >= 1 && < 1.5,
containers >= 0.1 && < 0.6, containers >= 0.1 && < 0.6,
array >= 0.1 && < 0.6 array >= 0.1 && < 0.6
Build-Depends: hpc Build-Depends: hpc
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment