Skip to content

GitLab

Commit ef8a08e0 authored by Alexey Kuleshevich's avatar Alexey Kuleshevich Committed by Marge Bot
1 Browse files
Options

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>
parent d1f3c637
Hide whitespace changes
Inline Side-by-side
Showing with 42 additions and 34 deletions
hpc @ f73c482d
Compare 4206323a...f73c482d
Subproject commit 4206323affaa6cc625a6f400c3da7cdd9c309461 Subproject commit f73c482db30a40cfa12074de51335b70a0974931
testsuite/tests/hpc/Makefile
View file @ ef8a08e0
...@@ -7,3 +7,11 @@ T11798: ...@@ -7,3 +7,11 @@ T11798:
"$(TEST_HC)" $(TEST_HC_ARGS) T11798 "$(TEST_HC)" $(TEST_HC_ARGS) T11798
"$(TEST_HC)" $(TEST_HC_ARGS) T11798 -fhpc "$(TEST_HC)" $(TEST_HC_ARGS) T11798 -fhpc
test -e .hpc/T11798.mix 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
View file @ ef8a08e0
module Main where
main :: IO ()
main = putStrLn "Добрый день"
testsuite/tests/hpc/T17073.stdout 0 → 100644
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
View file @ ef8a08e0
...@@ -21,3 +21,5 @@ test('T2991', [cmd_wrapper(T2991), extra_clean(['T2991LiterateModule.hi', ...@@ -21,3 +21,5 @@ test('T2991', [cmd_wrapper(T2991), extra_clean(['T2991LiterateModule.hi',
'T2991LiterateModule.o'])], 'T2991LiterateModule.o'])],
# Run with 'ghc --main'. Do not list other modules explicitly. # Run with 'ghc --main'. Do not list other modules explicitly.
multimod_compile_and_run, ['T2991', '']) multimod_compile_and_run, ['T2991', ''])
test('T17073', normal, makefile_test, ['T17073 HPC={hpc}'])
utils/hpc/HpcMarkup.hs
View file @ ef8a08e0
...@@ -7,14 +7,12 @@ module HpcMarkup (markup_plugin) where ...@@ -7,14 +7,12 @@ module HpcMarkup (markup_plugin) where
import Trace.Hpc.Mix import Trace.Hpc.Mix
import Trace.Hpc.Tix import Trace.Hpc.Tix
import Trace.Hpc.Util import Trace.Hpc.Util (HpcPos, fromHpcPos, writeFileUtf8)
import HpcFlags import HpcFlags
import HpcUtils import HpcUtils
import System.Directory
import System.FilePath import System.FilePath
import System.IO (localeEncoding)
import Data.List import Data.List
import Data.Maybe(fromJust) import Data.Maybe(fromJust)
import Data.Semigroup as Semi import Data.Semigroup as Semi
...@@ -82,10 +80,10 @@ markup_main flags (prog:modNames) = do ...@@ -82,10 +80,10 @@ markup_main flags (prog:modNames) = do
unless (verbosity flags < Normal) $ unless (verbosity flags < Normal) $
putStrLn $ "Writing: " ++ (filename <.> "html") putStrLn $ "Writing: " ++ (filename <.> "html")
writeFileUsing (dest_dir </> filename <.> "html") $ writeFileUtf8 (dest_dir </> filename <.> "html") $
"<html>" ++ "<html>" ++
"<head>" ++ "<head>" ++
charEncodingTag ++ "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">" ++
"<style type=\"text/css\">" ++ "<style type=\"text/css\">" ++
"table.bar { background-color: #f25913; }\n" ++ "table.bar { background-color: #f25913; }\n" ++
"td.bar { background-color: #60de51; }\n" ++ "td.bar { background-color: #60de51; }\n" ++
...@@ -139,11 +137,6 @@ markup_main flags (prog:modNames) = do ...@@ -139,11 +137,6 @@ markup_main flags (prog:modNames) = do
markup_main _ [] markup_main _ []
= hpcError markup_plugin $ "no .tix file or executable name specified" = 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 -- Add characters to the left of a string until it is at least as
-- large as requested. -- large as requested.
padLeft :: Int -> Char -> String -> String padLeft :: Int -> Char -> String -> String
...@@ -229,10 +222,10 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do ...@@ -229,10 +222,10 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
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) $ writeFileUtf8 (dest_dir </> fileName) $
unlines ["<html>", unlines ["<html>",
"<head>", "<head>",
charEncodingTag, "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">",
"<style type=\"text/css\">", "<style type=\"text/css\">",
"span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }", "span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }",
if invertOutput if invertOutput
...@@ -483,19 +476,6 @@ instance Monoid ModuleSummary where ...@@ -483,19 +476,6 @@ instance Monoid ModuleSummary where
} }
mappend = (<>) 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 -- global color pallete
......
utils/hpc/HpcUtils.hs
View file @ ef8a08e0
module HpcUtils where module HpcUtils where
import Trace.Hpc.Util import Trace.Hpc.Util (catchIO, HpcPos, fromHpcPos, readFileUtf8)
import qualified Data.Map as Map import qualified Data.Map as Map
import System.FilePath import System.FilePath
...@@ -25,12 +25,11 @@ grabHpcPos hsMap srcspan = ...@@ -25,12 +25,11 @@ grabHpcPos hsMap srcspan =
readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String
readFileFromPath _ filename@('/':_) _ = readFile filename readFileFromPath _ filename@('/':_) _ = readFileUtf8 filename
readFileFromPath err filename path0 = readTheFile path0 readFileFromPath err filename path0 = readTheFile path0
where where
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 (readFileUtf8 (dir </> filename))
return str)
(\ _ -> readTheFile dirs) (\ _ -> readTheFile dirs)
utils/hpc/hpc-bin.cabal
View file @ ef8a08e0
Name: hpc-bin Name: hpc-bin
-- XXX version number: -- XXX version number:
Version: 0.67 Version: 0.68
Copyright: XXX Copyright: XXX
License: BSD3 License: BSD3
-- XXX License-File: LICENSE -- XXX License-File: LICENSE
Author: XXX Author: XXX
Maintainer: XXX Maintainer: XXX
Synopsis: XXX Synopsis: XXX
Description: Description: XXX
XXX
Category: Development Category: Development
build-type: Simple build-type: Simple
cabal-version: >=1.10 cabal-version: >=1.10
...@@ -33,5 +32,5 @@ Executable hpc ...@@ -33,5 +32,5 @@ Executable hpc
filepath >= 1 && < 1.5, filepath >= 1 && < 1.5,
containers >= 0.1 && < 0.7, containers >= 0.1 && < 0.7,
array >= 0.1 && < 0.6, 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