[commit: ghc] ghc-8.6: Fix #15761 by adding parens (ba5d0a4)

[git at git.haskell.org]

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

On branch  : ghc-8.6
Link       : http://ghc.haskell.org/trac/ghc/changeset/ba5d0a4812a1437b11cacc53cc1a4024db6ad160/ghc

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

commit ba5d0a4812a1437b11cacc53cc1a4024db6ad160
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)


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

ba5d0a4812a1437b11cacc53cc1a4024db6ad160
 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, [''])