Commit 9ee3e581 authored by Alexey Kuleshevich's avatar Alexey Kuleshevich Committed by Ben Gamari

hpc: Fix encoding issues. Add test for and fix #17073

* Make sure files are being read/written in UTF-8. Set encoding while writing
  HTML output. Also set encoding while writing and reading .tix files although
  we don't yet have a ticket complaining that this poses problems.
* Set encoding in html header to utf8
* Upgrade to new version of 'hpc' library and reuse `readFileUtf8`
  and `writeFileUtf8` functions
* Update git submodule for `hpc`
* Bump up `hpc` executable version
Co-authored-by: Ben Gamari's avatarBen Gamari <ben@smart-cactus.org>
(cherry picked from commit afb23168fd28087ad0af339b559f90e3b70f2460)
parent 4156b877
Subproject commit 4206323affaa6cc625a6f400c3da7cdd9c309461
Subproject commit f73c482db30a40cfa12074de51335b70a0974931
......@@ -7,3 +7,11 @@ T11798:
"$(TEST_HC)" $(TEST_HC_ARGS) T11798
"$(TEST_HC)" $(TEST_HC_ARGS) T11798 -fhpc
test -e .hpc/T11798.mix
T17073:
LANG=ASCII "$(TEST_HC)" $(TEST_HC_ARGS) T17073.hs -fhpc -v0
./T17073
$(HPC) report T17073
$(HPC) version
LANG=ASCII $(HPC) markup T17073
module Main where
main :: IO ()
main = putStrLn "Добрый день"
Добрый день
100% expressions used (2/2)
100% boolean coverage (0/0)
100% guards (0/0)
100% 'if' conditions (0/0)
100% qualifiers (0/0)
100% alternatives used (0/0)
100% local declarations used (0/0)
100% top-level declarations used (1/1)
hpc tools, version 0.68
Writing: Main.hs.html
Writing: hpc_index.html
Writing: hpc_index_fun.html
Writing: hpc_index_alt.html
Writing: hpc_index_exp.html
\ No newline at end of file
......@@ -21,3 +21,5 @@ test('T2991', [cmd_wrapper(T2991), extra_clean(['T2991LiterateModule.hi',
'T2991LiterateModule.o'])],
# Run with 'ghc --main'. Do not list other modules explicitly.
multimod_compile_and_run, ['T2991', ''])
test('T17073', normal, makefile_test, ['T17073 HPC={hpc}'])
......@@ -7,14 +7,12 @@ module HpcMarkup (markup_plugin) where
import Trace.Hpc.Mix
import Trace.Hpc.Tix
import Trace.Hpc.Util
import Trace.Hpc.Util (HpcPos, fromHpcPos, writeFileUtf8)
import HpcFlags
import HpcUtils
import System.Directory
import System.FilePath
import System.IO (localeEncoding)
import Data.List
import Data.Maybe(fromJust)
import Data.Semigroup as Semi
......@@ -82,10 +80,10 @@ markup_main flags (prog:modNames) = do
unless (verbosity flags < Normal) $
putStrLn $ "Writing: " ++ (filename <.> "html")
writeFileUsing (dest_dir </> filename <.> "html") $
writeFileUtf8 (dest_dir </> filename <.> "html") $
"<html>" ++
"<head>" ++
charEncodingTag ++
"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">" ++
"<style type=\"text/css\">" ++
"table.bar { background-color: #f25913; }\n" ++
"td.bar { background-color: #60de51; }\n" ++
......@@ -139,11 +137,6 @@ markup_main flags (prog:modNames) = do
markup_main _ []
= hpcError markup_plugin $ "no .tix file or executable name specified"
charEncodingTag :: String
charEncodingTag =
"<meta http-equiv=\"Content-Type\" " ++
"content=\"text/html; " ++ "charset=" ++ show localeEncoding ++ "\">"
-- Add characters to the left of a string until it is at least as
-- large as requested.
padLeft :: Int -> Char -> String -> String
......@@ -229,10 +222,10 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
let fileName = modName0 <.> "hs" <.> "html"
unless (verbosity flags < Normal) $
putStrLn $ "Writing: " ++ fileName
writeFileUsing (dest_dir </> fileName) $
writeFileUtf8 (dest_dir </> fileName) $
unlines ["<html>",
"<head>",
charEncodingTag,
"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">",
"<style type=\"text/css\">",
"span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }",
if invertOutput
......@@ -483,19 +476,6 @@ instance Monoid ModuleSummary where
}
mappend = (<>)
------------------------------------------------------------------------------
writeFileUsing :: String -> String -> IO ()
writeFileUsing filename text = do
-- We need to check for the dest_dir each time, because we use sub-dirs for
-- packages, and a single .tix file might contain information about
-- many package.
-- create the dest_dir if needed
createDirectoryIfMissing True (takeDirectory filename)
writeFile filename text
------------------------------------------------------------------------------
-- global color pallete
......
module HpcUtils where
import Trace.Hpc.Util
import Trace.Hpc.Util (catchIO, HpcPos, fromHpcPos, readFileUtf8)
import qualified Data.Map as Map
import System.FilePath
......@@ -25,12 +25,11 @@ grabHpcPos hsMap srcspan =
readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String
readFileFromPath _ filename@('/':_) _ = readFile filename
readFileFromPath _ filename@('/':_) _ = readFileUtf8 filename
readFileFromPath err filename path0 = readTheFile path0
where
readTheFile [] = err $ "could not find " ++ show filename
++ " in path " ++ show path0
readTheFile (dir:dirs) =
catchIO (do str <- readFile (dir </> filename)
return str)
catchIO (readFileUtf8 (dir </> filename))
(\ _ -> readTheFile dirs)
Name: hpc-bin
-- XXX version number:
Version: 0.67
Version: 0.68
Copyright: XXX
License: BSD3
-- XXX License-File: LICENSE
Author: XXX
Maintainer: XXX
Synopsis: XXX
Description:
XXX
Description: XXX
Category: Development
build-type: Simple
cabal-version: >=1.10
......@@ -33,5 +32,5 @@ Executable hpc
filepath >= 1 && < 1.5,
containers >= 0.1 && < 0.7,
array >= 0.1 && < 0.6,
hpc
hpc >= 0.6.1 && < 0.7
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