[commit: ghc] ghc-7.10: Transliterate unknown characters at output (7a63e5e)

[git at git.haskell.org]

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

On branch  : ghc-7.10
Link       : http://ghc.haskell.org/trac/ghc/changeset/7a63e5e7e34eff930aa7ee534d56330d683f2504/ghc

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

commit 7a63e5e7e34eff930aa7ee534d56330d683f2504
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


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

7a63e5e7e34eff930aa7ee534d56330d683f2504
 compiler/utils/Util.hs       | 16 ++++++++++++++++
 ghc/Main.hs                  |  3 +++
 testsuite/tests/driver/all.T |  7 +------
 3 files changed, 20 insertions(+), 6 deletions(-)

diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs
index b2492f1..2e357c1 100644
--- a/compiler/utils/Util.hs
+++ b/compiler/utils/Util.hs
@@ -82,6 +82,7 @@ module Util (
         doesDirNameExist,
         getModificationUTCTime,
         modificationTimeIfExists,
+        hSetTranslit,
 
         global, consIORef, globalM,
 
@@ -121,6 +122,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
@@ -970,6 +973,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 d30a50b..7b1c244 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 a260a17..6b07d47 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -384,12 +384,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',
-     # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X
-     [when(opsys('mingw32'), expect_fail), when(opsys('darwin'), expect_fail),
-      expect_broken(6037)],
-     run_command,
+test('T6037', normal, run_command,
      ['$MAKE -s --no-print-directory T6037'])
 
 test('T2507',