Pretty-print strict record fields from ifaces correctly
authorRyan Scott <ryan.gl.scott@gmail.com>
Sat, 20 May 2017 16:56:50 +0000 (12:56 -0400)
committerBen Gamari <ben@smart-cactus.org>
Sat, 20 May 2017 20:29:18 +0000 (16:29 -0400)
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

compiler/iface/IfaceSyn.hs
testsuite/tests/ghci/scripts/T13699.hs [new file with mode: 0644]
testsuite/tests/ghci/scripts/T13699.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/T13699.stdout [new file with mode: 0644]
testsuite/tests/ghci/scripts/all.T

index 338397d..60206ea 100644 (file)
@@ -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 (file)
index 0000000..0579399
--- /dev/null
@@ -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 (file)
index 0000000..8decf0b
--- /dev/null
@@ -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 (file)
index 0000000..b5950a7
--- /dev/null
@@ -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
index ae0a528..8ef45fe 100755 (executable)
@@ -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'])