hpc: Fix encoding issues. Add test for and fix #17073
authorAlexey Kuleshevich <alexey@kuleshevi.ch>
Sun, 18 Aug 2019 07:38:37 +0000 (03:38 -0400)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Wed, 20 Nov 2019 01:39:20 +0000 (20:39 -0500)
* 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>
libraries/hpc
testsuite/tests/hpc/Makefile
testsuite/tests/hpc/T17073.hs [new file with mode: 0644]
testsuite/tests/hpc/T17073.stdout [new file with mode: 0644]
testsuite/tests/hpc/all.T
utils/hpc/HpcMarkup.hs
utils/hpc/HpcUtils.hs
utils/hpc/hpc-bin.cabal

index 4206323..f73c482 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 4206323affaa6cc625a6f400c3da7cdd9c309461
+Subproject commit f73c482db30a40cfa12074de51335b70a0974931
index 6de7cee..5945bb8 100644 (file)
@@ -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 (file)
index 0000000..d1e0a45
--- /dev/null
@@ -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 (file)
index 0000000..db489a3
--- /dev/null
@@ -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
index ed68e29..bd32c64 100644 (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}'])
index a9b5ce1..7051960 100644 (file)
@@ -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
index 6ee44b1..da62f4a 100644 (file)
@@ -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)
index a1368cf..28cc2af 100644 (file)
@@ -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