diff options
| author | Alexey Kuleshevich <alexey@kuleshevi.ch> | 2019-08-18 07:38:37 (GMT) |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-11-20 01:39:20 (GMT) |
| commit | ef8a08e0dd4e5b908b7fbce1b3101dc311c4d3e1 (patch) | |
| tree | a30180b45f705c3006fb4628b2e6284aab49f065 | |
| parent | d1f3c63701b7f0fd675f792af7f33c5b11eaff83 (diff) | |
| download | ghc-ef8a08e0dd4e5b908b7fbce1b3101dc311c4d3e1.zip ghc-ef8a08e0dd4e5b908b7fbce1b3101dc311c4d3e1.tar.gz ghc-ef8a08e0dd4e5b908b7fbce1b3101dc311c4d3e1.tar.bz2 | |
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 <ben@smart-cactus.org>
| m--------- | libraries/hpc | 0 | ||||
| -rw-r--r-- | testsuite/tests/hpc/Makefile | 8 | ||||
| -rw-r--r-- | testsuite/tests/hpc/T17073.hs | 5 | ||||
| -rw-r--r-- | testsuite/tests/hpc/T17073.stdout | 15 | ||||
| -rw-r--r-- | testsuite/tests/hpc/all.T | 2 | ||||
| -rw-r--r-- | utils/hpc/HpcMarkup.hs | 30 | ||||
| -rw-r--r-- | utils/hpc/HpcUtils.hs | 7 | ||||
| -rw-r--r-- | utils/hpc/hpc-bin.cabal | 7 |
8 files changed, 41 insertions, 33 deletions
diff --git a/libraries/hpc b/libraries/hpc -Subproject 4206323affaa6cc625a6f400c3da7cdd9c30946 +Subproject f73c482db30a40cfa12074de51335b70a097493 diff --git a/testsuite/tests/hpc/Makefile b/testsuite/tests/hpc/Makefile index 6de7cee..5945bb8 100644 --- a/testsuite/tests/hpc/Makefile +++ b/testsuite/tests/hpc/Makefile @@ -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 + diff --git a/testsuite/tests/hpc/T17073.hs b/testsuite/tests/hpc/T17073.hs new file mode 100644 index 0000000..d1e0a45 --- /dev/null +++ b/testsuite/tests/hpc/T17073.hs @@ -0,0 +1,5 @@ +module Main where + +main :: IO () +main = putStrLn "Добрый день" + diff --git a/testsuite/tests/hpc/T17073.stdout b/testsuite/tests/hpc/T17073.stdout new file mode 100644 index 0000000..db489a3 --- /dev/null +++ b/testsuite/tests/hpc/T17073.stdout @@ -0,0 +1,15 @@ +Добрый день +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 diff --git a/testsuite/tests/hpc/all.T b/testsuite/tests/hpc/all.T index ed68e29..bd32c64 100644 --- a/testsuite/tests/hpc/all.T +++ b/testsuite/tests/hpc/all.T @@ -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}']) diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index a9b5ce1..7051960 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -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 @@ -484,19 +477,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 red,green,yellow :: String diff --git a/utils/hpc/HpcUtils.hs b/utils/hpc/HpcUtils.hs index 6ee44b1..da62f4a 100644 --- a/utils/hpc/HpcUtils.hs +++ b/utils/hpc/HpcUtils.hs @@ -1,6 +1,6 @@ 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) diff --git a/utils/hpc/hpc-bin.cabal b/utils/hpc/hpc-bin.cabal index a1368cf..28cc2af 100644 --- a/utils/hpc/hpc-bin.cabal +++ b/utils/hpc/hpc-bin.cabal @@ -1,14 +1,13 @@ 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 |