[commit: ghc] master: Only use UnicodeSytanx pretty printing if the locale supports it (6e4a750)
git at git.haskell.org
git at git.haskell.org
Fri Jun 6 16:56:55 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/6e4a75001fae1bf9251907d605b3f0b74da537cb/ghc
>---------------------------------------------------------------
commit 6e4a75001fae1bf9251907d605b3f0b74da537cb
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Fri Jun 6 18:07:29 2014 +0200
Only use UnicodeSytanx pretty printing if the locale supports it
using the same check as for unicode quotes.
>---------------------------------------------------------------
6e4a75001fae1bf9251907d605b3f0b74da537cb
compiler/main/DynFlags.hs | 18 +++++++++---------
compiler/main/DynFlags.hs-boot | 2 +-
compiler/utils/Outputable.lhs | 9 +++++----
testsuite/tests/driver/Makefile | 4 ++++
testsuite/tests/driver/T8959a.hs | 5 +++++
testsuite/tests/driver/T8959a.stderr | 5 +++++
testsuite/tests/driver/all.T | 5 +++++
7 files changed, 34 insertions(+), 14 deletions(-)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index ea4d008..0c49386 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -777,7 +777,7 @@ data DynFlags = DynFlags {
pprCols :: Int,
traceLevel :: Int, -- Standard level is 1. Less verbose is 0.
- useUnicodeQuotes :: Bool,
+ useUnicode :: Bool,
-- | what kind of {-# SCC #-} to add automatically
profAuto :: ProfAuto,
@@ -1295,12 +1295,12 @@ initDynFlags dflags = do
refRtldInfo <- newIORef Nothing
refRtccInfo <- newIORef Nothing
wrapperNum <- newIORef emptyModuleEnv
- canUseUnicodeQuotes <- do let enc = localeEncoding
- str = "‘’"
- (withCString enc str $ \cstr ->
- do str' <- peekCString enc cstr
- return (str == str'))
- `catchIOError` \_ -> return False
+ canUseUnicode <- do let enc = localeEncoding
+ str = "‘’"
+ (withCString enc str $ \cstr ->
+ do str' <- peekCString enc cstr
+ return (str == str'))
+ `catchIOError` \_ -> return False
return dflags{
canGenerateDynamicToo = refCanGenerateDynamicToo,
nextTempSuffix = refNextTempSuffix,
@@ -1310,7 +1310,7 @@ initDynFlags dflags = do
generatedDumps = refGeneratedDumps,
llvmVersion = refLlvmVersion,
nextWrapperNum = wrapperNum,
- useUnicodeQuotes = canUseUnicodeQuotes,
+ useUnicode = canUseUnicode,
rtldInfo = refRtldInfo,
rtccInfo = refRtccInfo
}
@@ -1449,7 +1449,7 @@ defaultDynFlags mySettings =
flushErr = defaultFlushErr,
pprUserLength = 5,
pprCols = 100,
- useUnicodeQuotes = False,
+ useUnicode = False,
traceLevel = 1,
profAuto = NoProfAuto,
llvmVersion = panic "defaultDynFlags: No llvmVersion",
diff --git a/compiler/main/DynFlags.hs-boot b/compiler/main/DynFlags.hs-boot
index f3f472a..5cf2166 100644
--- a/compiler/main/DynFlags.hs-boot
+++ b/compiler/main/DynFlags.hs-boot
@@ -9,5 +9,5 @@ targetPlatform :: DynFlags -> Platform
pprUserLength :: DynFlags -> Int
pprCols :: DynFlags -> Int
unsafeGlobalDynFlags :: DynFlags
-useUnicodeQuotes :: DynFlags -> Bool
+useUnicode :: DynFlags -> Bool
useUnicodeSyntax :: DynFlags -> Bool
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index a933fee..e32261d 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -74,7 +74,7 @@ module Outputable (
import {-# SOURCE #-} DynFlags( DynFlags,
targetPlatform, pprUserLength, pprCols,
- useUnicodeQuotes, useUnicodeSyntax,
+ useUnicode, useUnicodeSyntax,
unsafeGlobalDynFlags )
import {-# SOURCE #-} Module( Module, ModuleName, moduleName )
import {-# SOURCE #-} OccName( OccName )
@@ -459,7 +459,7 @@ cparen b d = SDoc $ Pretty.cparen b . runSDoc d
-- so that we don't get `foo''. Instead we just have foo'.
quotes d =
sdocWithDynFlags $ \dflags ->
- if useUnicodeQuotes dflags
+ if useUnicode dflags
then char '‘' <> d <> char '’'
else SDoc $ \sty ->
let pp_d = runSDoc d sty
@@ -501,8 +501,9 @@ forAllLit = unicodeSyntax (char '∀') (ptext (sLit "forall"))
unicodeSyntax :: SDoc -> SDoc -> SDoc
unicodeSyntax unicode plain = sdocWithDynFlags $ \dflags ->
- if useUnicodeSyntax dflags then unicode
- else plain
+ if useUnicode dflags && useUnicodeSyntax dflags
+ then unicode
+ else plain
nest :: Int -> SDoc -> SDoc
-- ^ Indent 'SDoc' some specified amount
diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile
index 3603bb6..37b661c 100644
--- a/testsuite/tests/driver/Makefile
+++ b/testsuite/tests/driver/Makefile
@@ -556,6 +556,10 @@ T6037:
T2507:
-LC_ALL=C "$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -c T2507.hs
+.PHONY: T8959a
+T8959a:
+ -LC_ALL=C "$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -c T8959a.hs -XUnicodeSyntax
+
.PHONY: T703
T703:
$(RM) -rf T703
diff --git a/testsuite/tests/driver/T8959a.hs b/testsuite/tests/driver/T8959a.hs
new file mode 100644
index 0000000..6f8fd77
--- /dev/null
+++ b/testsuite/tests/driver/T8959a.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE UnicodeSyntax #-}
+module T8959a where
+
+foo :: Int -> Int
+foo = ()
diff --git a/testsuite/tests/driver/T8959a.stderr b/testsuite/tests/driver/T8959a.stderr
new file mode 100644
index 0000000..f270bb6
--- /dev/null
+++ b/testsuite/tests/driver/T8959a.stderr
@@ -0,0 +1,5 @@
+
+T8959a.hs:5:7:
+ Couldn't match expected type `Int -> Int' with actual type `()'
+ In the expression: ()
+ In an equation for `foo': foo = ()
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index 69f4cd3..45c7662 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -391,6 +391,11 @@ test('T2507',
[when(opsys('mingw32'), expect_fail), when(opsys('darwin'), expect_fail)],
run_command,
['$MAKE -s --no-print-directory T2507'])
+test('T8959a',
+ # 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)],
+ run_command,
+ ['$MAKE -s --no-print-directory T8959a'])
test('T703', normal, run_command, ['$MAKE -s --no-print-directory T703'])
test('T8101', normal, compile, ['-Wall -fno-code'])
More information about the ghc-commits
mailing list