[commit: ghc] master: Transliterate unknown characters at output (22aca53)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/22aca5368864070bbed3b44dca3ce57e243bf415/ghc

>---------------------------------------------------------------

commit 22aca5368864070bbed3b44dca3ce57e243bf415
Author: Michael Snoyman <michael at snoyman.com>
Date:   Tue Aug 18 17:58:02 2015 +0200

    Transliterate unknown characters at output
    
    This avoids the compiler from crashing when, for example, a warning
    contains a non-Latin identifier and the LANG variable is set to C.
    Fixes #6037.
    
    Test Plan:
    Create a Haskell source file containing an identifier with non-Latin
    characters and no type signature. Compile with `LANG=C ghc -Wall
    foo.hs`, and it should fail. With this patch, it will succeed.
    
    Reviewers: austin, rwbarton, bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1153
    
    GHC Trac Issues: #6037, #10762


>---------------------------------------------------------------

22aca5368864070bbed3b44dca3ce57e243bf415
 compiler/utils/Util.hs       | 16 ++++++++++++++++
 ghc/Main.hs                  |  3 +++
 testsuite/tests/driver/all.T |  2 +-
 3 files changed, 20 insertions(+), 1 deletion(-)

diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs
index 96cd752..96e911e 100644
--- a/compiler/utils/Util.hs
+++ b/compiler/utils/Util.hs
@@ -83,6 +83,7 @@ module Util (
         doesDirNameExist,
         getModificationUTCTime,
         modificationTimeIfExists,
+        hSetTranslit,
 
         global, consIORef, globalM,
 
@@ -122,6 +123,8 @@ import Control.Applicative (Applicative)
 #endif
 import Control.Applicative ( liftA2 )
 import Control.Monad    ( liftM )
+import GHC.IO.Encoding (mkTextEncoding, textEncodingName)
+import System.IO (Handle, hGetEncoding, hSetEncoding)
 import System.IO.Error as IO ( isDoesNotExistError )
 import System.Directory ( doesDirectoryExist, getModificationTime )
 import System.FilePath
@@ -978,6 +981,19 @@ modificationTimeIfExists f = do
                         then return Nothing
                         else ioError e
 
+-- --------------------------------------------------------------
+-- Change the character encoding of the given Handle to transliterate
+-- on unsupported characters instead of throwing an exception
+
+hSetTranslit :: Handle -> IO ()
+hSetTranslit h = do
+    menc <- hGetEncoding h
+    case fmap textEncodingName menc of
+        Just name | '/' `notElem` name -> do
+            enc' <- mkTextEncoding $ name ++ "//TRANSLIT"
+            hSetEncoding h enc'
+        _ -> return ()
+
 -- split a string at the last character where 'pred' is True,
 -- returning a pair of strings. The first component holds the string
 -- up (but not including) the last character for which 'pred' returned
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 201ee5d..ed2ac67 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -80,6 +80,9 @@ main = do
    initGCStatistics -- See Note [-Bsymbolic and hooks]
    hSetBuffering stdout LineBuffering
    hSetBuffering stderr LineBuffering
+   hSetTranslit stdout
+   hSetTranslit stderr
+
    GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
     -- 1. extract the -B flag from the args
     argv0 <- getArgs
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index b79f166..a11c0f1 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -382,7 +382,7 @@ test('T7060',
 test('T7130', normal, compile_fail, ['-fflul-laziness'])
 test('T7563', when(unregisterised(), skip), run_command,
      ['$MAKE -s --no-print-directory T7563'])
-test('T6037', expect_broken(6037), run_command,
+test('T6037', normal, run_command,
      ['$MAKE -s --no-print-directory T6037'])
 test('T2507',
      # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X