[commit: ghc] master: Pretty-print strict record fields from ifaces correctly (2108460)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/2108460f9211bf5eab98e0f2f3218dcd271eeaad/ghc

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

commit 2108460f9211bf5eab98e0f2f3218dcd271eeaad
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Sat May 20 12:56:50 2017 -0400

    Pretty-print strict record fields from ifaces correctly
    
    We need to use parentheses more when pretty-printing types with bang
    patterns within constructors that use record syntax. Fixes #13699.
    
    Test Plan: make test TEST=T13699
    
    Reviewers: austin, bgamari, dfeuer
    
    Reviewed By: dfeuer
    
    Subscribers: dfeuer, rwbarton, thomie
    
    GHC Trac Issues: #13699
    
    Differential Revision: https://phabricator.haskell.org/D3587


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

2108460f9211bf5eab98e0f2f3218dcd271eeaad
 compiler/iface/IfaceSyn.hs                 | 10 +++++++++-
 testsuite/tests/ghci/scripts/T13699.hs     | 10 ++++++++++
 testsuite/tests/ghci/scripts/T13699.script |  3 +++
 testsuite/tests/ghci/scripts/T13699.stdout |  8 ++++++++
 testsuite/tests/ghci/scripts/all.T         |  1 +
 5 files changed, 31 insertions(+), 1 deletion(-)

diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index 338397d..60206ea 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -1003,7 +1003,15 @@ pprIfaceConDecl ss gadt_style tycon tc_binders parent
                                pprParendIfaceCoercion co
 
     pprParendBangTy (bang, ty) = ppr_bang bang <> pprParendIfaceType ty
-    pprBangTy       (bang, ty) = ppr_bang bang <> ppr ty
+    pprBangTy       (bang, ty) = ppr_bang bang <> ppr_banged_ty ty
+      where
+        -- The presence of bang patterns or UNPACK annotations requires
+        -- surrounding the type with parentheses, if needed (#13699)
+        ppr_banged_ty = case bang of
+                          IfNoBang     -> ppr
+                          IfStrict     -> pprParendIfaceType
+                          IfUnpack     -> pprParendIfaceType
+                          IfUnpackCo{} -> pprParendIfaceType
 
     pp_args :: [SDoc]  -- With parens, e.g  (Maybe a)  or  !(Maybe a)
     pp_args = map pprParendBangTy tys_w_strs
diff --git a/testsuite/tests/ghci/scripts/T13699.hs b/testsuite/tests/ghci/scripts/T13699.hs
new file mode 100644
index 0000000..0579399
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13699.hs
@@ -0,0 +1,10 @@
+module T13699 where
+
+data Foo = Foo
+  { foo1 :: Int
+  , foo2 :: !Int
+  , foo3 :: Maybe Int
+  , foo4 :: !(Maybe Int)
+  }
+
+data Bar = Bar Int !Int (Maybe Int) !(Maybe Int)
diff --git a/testsuite/tests/ghci/scripts/T13699.script b/testsuite/tests/ghci/scripts/T13699.script
new file mode 100644
index 0000000..8decf0b
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13699.script
@@ -0,0 +1,3 @@
+:load T13699
+:i Foo
+:i Bar
diff --git a/testsuite/tests/ghci/scripts/T13699.stdout b/testsuite/tests/ghci/scripts/T13699.stdout
new file mode 100644
index 0000000..b5950a7
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13699.stdout
@@ -0,0 +1,8 @@
+data Foo
+  = Foo {foo1 :: Int,
+         foo2 :: !Int,
+         foo3 :: Maybe Int,
+         foo4 :: !(Maybe Int)}
+  	-- Defined at T13699.hs:3:1
+data Bar = Bar Int !Int (Maybe Int) !(Maybe Int)
+  	-- Defined at T13699.hs:10:1
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index ae0a528..8ef45fe 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -255,3 +255,4 @@ test('T13420', normal, ghci_script, ['T13420.script'])
 test('T13466', normal, ghci_script, ['T13466.script'])
 test('GhciCurDir', normal, ghci_script, ['GhciCurDir.script'])
 test('T13591', expect_broken(13591), ghci_script, ['T13591.script'])
+test('T13699', normal, ghci_script, ['T13699.script'])