Skip to content
Snippets Groups Projects
Commit ef8a08e0 authored by Alexey Kuleshevich's avatar Alexey Kuleshevich Committed by Marge Bot
Browse files

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: default avatarBen Gamari <ben@smart-cactus.org>
parent d1f3c637
No related merge requests found
Hide whitespace changes
Inline Side-by-side
hpc @ f73c482d
Compare 4206323a...f73c482d
Subproject commit 4206323affaa6cc625a6f400c3da7cdd9c309461
Subproject commit f73c482db30a40cfa12074de51335b70a0974931
testsuite/tests/hpc/Makefile
+ 8
− 0
View file @ ef8a08e0
......@@ -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
testsuite/tests/hpc/T17073.hs 0 → 100644
+ 5
− 0
View file @ ef8a08e0
module Main where
main :: IO ()
main = putStrLn "Добрый день"
testsuite/tests/hpc/T17073.stdout 0 → 100644
+ 15
− 0
View file @ ef8a08e0
Добрый день
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
testsuite/tests/hpc/all.T
+ 2
− 0
View file @ ef8a08e0
......@@ -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}'])
utils/hpc/HpcMarkup.hs
+ 5
− 25
View file @ ef8a08e0
......@@ -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
......
utils/hpc/HpcUtils.hs
+ 3
− 4
View file @ ef8a08e0
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)
utils/hpc/hpc-bin.cabal
+ 3
− 4
View file @ ef8a08e0
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
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