[commit: ghc] ghc-8.6: Fix #15761 by adding parens (bf667f9)
git at git.haskell.org
git at git.haskell.org
Wed Oct 17 18:45:18 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.6
Link : http://ghc.haskell.org/trac/ghc/changeset/bf667f9d6b9c4e39584217f7828952600cfc00a6/ghc
>---------------------------------------------------------------
commit bf667f9d6b9c4e39584217f7828952600cfc00a6
Author: Richard Eisenberg <rae at cs.brynmawr.edu>
Date: Wed Oct 17 10:46:21 2018 -0400
Fix #15761 by adding parens
This was just a pretty-printer infelicity. Fixed now.
Test case: printer/T15761
(cherry picked from commit 38c28c1a8bb129141e533866700e7318314f32c1)
>---------------------------------------------------------------
bf667f9d6b9c4e39584217f7828952600cfc00a6
compiler/hsSyn/HsDecls.hs | 16 +++++++++-------
testsuite/tests/printer/T15761.hs | 5 +++++
testsuite/tests/printer/T15761.stderr | 5 +++++
testsuite/tests/printer/all.T | 1 +
4 files changed, 20 insertions(+), 7 deletions(-)
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index 277a6d3..f84fcfd 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -1713,13 +1713,15 @@ pprFamInstLHS thing typats fixity context mb_kind_sig
-- explicit type patterns
= hsep [ pprHsContext context, pp_pats typats, pp_kind_sig ]
where
- pp_pats (patl:patsr)
- | fixity == Infix
- = hsep [pprHsType (unLoc patl), pprInfixOcc (unLoc thing)
- , hsep (map (pprHsType.unLoc) patsr)]
- | otherwise = hsep [ pprPrefixOcc (unLoc thing)
- , hsep (map (pprHsType.unLoc) (patl:patsr))]
- pp_pats [] = pprPrefixOcc (unLoc thing)
+ pp_pats (patl:patr:pats)
+ | Infix <- fixity
+ = let pp_op_app = hsep [ ppr patl, pprInfixOcc (unLoc thing), ppr patr ] in
+ case pats of
+ [] -> pp_op_app
+ _ -> hsep (parens pp_op_app : map ppr pats)
+
+ pp_pats pats = hsep [ pprPrefixOcc (unLoc thing)
+ , hsep (map ppr pats)]
pp_kind_sig
| Just k <- mb_kind_sig
diff --git a/testsuite/tests/printer/T15761.hs b/testsuite/tests/printer/T15761.hs
new file mode 100644
index 0000000..866002f
--- /dev/null
+++ b/testsuite/tests/printer/T15761.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeFamilies, TypeOperators #-}
+
+data family (a + b) c d
+
+data instance (Int + Bool) Double = Float
diff --git a/testsuite/tests/printer/T15761.stderr b/testsuite/tests/printer/T15761.stderr
new file mode 100644
index 0000000..10425b4
--- /dev/null
+++ b/testsuite/tests/printer/T15761.stderr
@@ -0,0 +1,5 @@
+
+T15761.hs:5:1: error:
+ • Expecting one more argument to ‘(Int + Bool) Double’
+ Expected a type, but ‘(Int + Bool) Double’ has kind ‘* -> *’
+ • In the data instance declaration for ‘+’
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index 203efa4..7f45c74 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -56,3 +56,4 @@ test('T14289c', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T142
test('T14306', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T14306'])
test('T14343', normal, compile_fail, [''])
test('T14343b', normal, compile_fail, [''])
+test('T15761', normal, compile_fail, [''])
More information about the ghc-commits
mailing list