Line wrap when pp long expressions (fixes #16874)
authorAlfredo Di Napoli <alfredo.dinapoli@gmail.com>
Sat, 13 Jul 2019 16:07:17 +0000 (18:07 +0200)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Sat, 20 Jul 2019 11:52:01 +0000 (07:52 -0400)
This commit fixes #16874 by using `fsep` rather than `sep` when pretty
printing long patterns and expressions.

compiler/hsSyn/HsExpr.hs
compiler/hsSyn/HsPat.hs
testsuite/tests/typecheck/should_fail/T16874.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T16874.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/all.T

index 6bfdad1..69379bc 100644 (file)
@@ -1077,7 +1077,7 @@ ppr_apps (HsApp _ (L _ fun) arg)        args
   = ppr_apps fun (Left arg : args)
 ppr_apps (HsAppType _ (L _ fun) arg)    args
   = ppr_apps fun (Right arg : args)
-ppr_apps fun args = hang (ppr_expr fun) 2 (sep (map pp args))
+ppr_apps fun args = hang (ppr_expr fun) 2 (fsep (map pp args))
   where
     pp (Left arg)                             = ppr arg
     -- pp (Right (LHsWcTypeX (HsWC { hswc_body = L _ arg })))
index 9f8d2a5..06270e8 100644 (file)
@@ -584,7 +584,7 @@ pprUserCon c details          = pprPrefixOcc c <+> pprConArgs details
 
 pprConArgs :: (OutputableBndrId (GhcPass p))
            => HsConPatDetails (GhcPass p) -> SDoc
-pprConArgs (PrefixCon pats) = sep (map (pprParendLPat appPrec) pats)
+pprConArgs (PrefixCon pats) = fsep (map (pprParendLPat appPrec) pats)
 pprConArgs (InfixCon p1 p2) = sep [ pprParendLPat appPrec p1
                                   , pprParendLPat appPrec p2 ]
 pprConArgs (RecCon rpats)   = ppr rpats
diff --git a/testsuite/tests/typecheck/should_fail/T16874.hs b/testsuite/tests/typecheck/should_fail/T16874.hs
new file mode 100644 (file)
index 0000000..4223400
--- /dev/null
@@ -0,0 +1,12 @@
+
+module Main where
+
+type A = Int
+data D = D A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A
+
+test :: D -> D
+test (D a b c d e f g h i j k l m n o p q r s t u v w x y z aa bb cc dd ee ff gg hh ii jj kk ll mm nn)
+  = D a b c d e f g h i j k l m n o p q r s t u v w x y z aa bb cc dd ee ff gg hh ii jj kk ll mm nn
+
+main :: IO ()
+main = print ()
diff --git a/testsuite/tests/typecheck/should_fail/T16874.stderr b/testsuite/tests/typecheck/should_fail/T16874.stderr
new file mode 100644 (file)
index 0000000..7c9d7ef
--- /dev/null
@@ -0,0 +1,12 @@
+
+T16874.hs:8:7: error:
+    • The constructor ‘D’ should have 41 arguments, but has been given 40
+    • In the pattern:
+        D a b c d e f g h i j k l m n o p q r s t u v w x y z aa bb cc dd
+          ee ff gg hh ii jj kk ll mm nn
+      In an equation for ‘test’:
+          test
+            (D a b c d e f g h i j k l m n o p q r s t u v w x y z aa bb cc dd
+               ee ff gg hh ii jj kk ll mm nn)
+            = D a b c d e f g h i j k l m n o p q r s t u v w x y z aa bb cc dd
+                ee ff gg hh ii jj kk ll mm nn
index fd6790b..fc49dbb 100644 (file)
@@ -527,6 +527,7 @@ test('T15883e', normal, compile_fail, [''])
 test('T16821', normal, compile_fail, [''])
 test('T16829a', normal, compile_fail, [''])
 test('T16829b', normal, compile_fail, [''])
+test('T16874', normal, compile_fail, [''])
 test('UnliftedNewtypesFail', normal, compile_fail, [''])
 test('UnliftedNewtypesNotEnabled', normal, compile_fail, [''])
 test('UnliftedNewtypesCoerceFail', normal, compile_fail, [''])