diff options
author | Thomas Miedema <thomasmiedema@gmail.com> | 2015-08-05 10:58:54 +0200 |
---|---|---|
committer | Thomas Miedema <thomasmiedema@gmail.com> | 2015-08-12 11:19:14 +0200 |
commit | bcfae08c0be0fa8604e2025733dfae57e37c2083 (patch) | |
tree | 29745f2631084fa35fd3f364d5bd75c51c522cb4 | |
parent | 67576ddc67f39bef43c473f30af0887d22011710 (diff) | |
download | haskell-bcfae08c0be0fa8604e2025733dfae57e37c2083.tar.gz |
Pretty: fix potential bad formatting of error message (#10735)
This is a backport of a bug fix by Benedikt Huber for the same problem
in the pretty library (#1337), from commit
8d8866a8379c2fe8108ef034893c59e06d5e752f. The original explanation for
the fix is attached below.
Ticket #1776 originally reported an infinite loop when printing error
message. This promptly got fixed in:
commit 2d52ee06786e5caf0c2d65a4b4bb7c45c6493190
Author: simonpj@microsoft.com <unknown>
Date: Thu Mar 1 11:45:13 2007 +0000
Do not go into an infinite loop when pretty-printer finds a
negative indent (Trac #1176)
SPJ reports in the ticket: "So infinite loop is fixed, but the bad
formatting remains. I've added a test, tcfail177."
tcfail177 however hasn't triggered the formatting problem for years (as
Ian reported in c9e0e6067a47c574d9ff3721afe58e30ca1be3e4).
This patch updates the test to a version that at least still failed with
ghc-7.0 (from #1776#comment:7).
-------------------
From https://mail.haskell.org/pipermail/libraries/2008-June/010013.html,
by Benedikt Huber:
Concerning ticket #1337, we have to change the formal specification of
fill (it doesn't match the implementation):
-- Current Specification:
-- fill [] = empty
-- fill [p] = p
-- fill (p1:p2:ps) = oneLiner p1 <#> nest (length p1)
-- (fill (oneLiner p2 : ps))
-- `union`
-- p1 $$ fill ps
Problem 1: We want to `unnest' the second argument of (p1 $$ fill ps),
but not the first one
In the definition above we have e.g.
> getSecondLayout $
> fillDef False [text "a", text "b", text "a"]
>> text "ab"; nilabove; nest -1; text "a"; empty
>> |ab|
>> |.a|
Problem 2: The overlapping $$ should only be used for those layouts of
p1 which aren't one liners (otherwise violating the invariant "Left
union arg has shorter first line").
I suggest the following specification (i believe it almost matches the
current implementation, modulo [fillNB: fix bug #1337] (see below):
-- Revised Specification:
-- fill g docs = fill' 0 docs
-- gap g = if g then 1 else 0
-- fill' n [] = []
-- fill' n [p] = [p]
-- fill' n (p1:p2:ps) =
-- oneLiner p1 <g> (fill' (n+length p1+gap g) (oneLiner p2 : ps))
-- `union`
-- (p1 $*$ nest (-n) (fill' g ps))
--
-- $*$ is defined for layouts (One-Layout Documents) as
--
-- layout1 $*$ layout2 | isOneLiner layout1 = layout1 $+$ layout2
-- | otherwise = layout1 $$ layout2
I've also implemented the specification in HughesPJQuickCheck.hs,
and checked them against the patched pretty printer.
Concerning Bug #1337:
~~~~~~~~~~~~~~~~~~~~~
If the above formal specification is fine, it is easy to fix:
elide the nests of (oneLiner p2) [see attached patch, record bug #1337].
> PrettyPrint(0) $ ./Bug1337
> ....ab
> ...c
The (long) explanation follows below.
<snip/>
===========================================================
Explanation of Bug #1337:
Consider
> fcat [ nest 1 $ text "a", nest 2 $ text "b", text "c"]
--> expected: (nest 1; text "a"; text "b"; nest -3; "c")
--> actual : (nest 1; text "a"; text "b"; nest -5; "c")
Reduction:
=== (nest 1; text a) <> (fill (-2) (p2:ps))
==> (nest 2 (text "b") $+$ text "c")
==> (nest 2 (text "b")) `nilabove`
(nest (-3) (text "c"))
==> (nest 1; text a; text b; nest -5 c)
The problem is that if we decide to layout (p1:p2:ps) as
| p1 p2
| ps
(call it layout A), then we want to have
> (p1 <> p2) $+$ ps.
But following law <n6> this means that
> fcat_A [p1:nest k p2:ps]
is equivalent to
> fcat_A [p1,p2,ps]
so the nest of p2 has to be removed.
This is somewhat similar to bug #667, but easier to fix
from a semantic point of view:
p1,p2 and ps are distinct layouts - we only have to preserve the
individual layouts, and no combinations of them.
-rw-r--r-- | compiler/utils/Pretty.hs | 5 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/tcfail177.hs | 65 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/tcfail177.stderr | 180 |
3 files changed, 66 insertions, 184 deletions
diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 607d265e82..99566d36ea 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -822,11 +822,14 @@ fillNB g p k ys = fill1 g p k ys fillNBE :: Bool -> Int -> Doc -> [Doc] -> Doc fillNBE g k y ys - = nilBeside g (fill1 g ((oneLiner . reduceDoc) y) k' ys) + = nilBeside g (fill1 g ((elideNest . oneLiner . reduceDoc) y) k' ys) -- XXX: TODO: PRETTY: Used to use True here (but GHC used False...) `mkUnion` nilAboveNest False k (fill g (y:ys)) where k' = if g then k - 1 else k +elideNest :: Doc -> Doc +elideNest (Nest _ d) = d +elideNest d = d -- --------------------------------------------------------------------------- -- Selecting the best layout diff --git a/testsuite/tests/typecheck/should_fail/tcfail177.hs b/testsuite/tests/typecheck/should_fail/tcfail177.hs index d9e60e96fc..8d264db53d 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail177.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail177.hs @@ -2,33 +2,58 @@ module ShouldFail where -- See Trac #1176 -- This is really a pretty-printer test, not a typechecker test --- The more infix ops we have, the worse fsep works +-- +-- Before ghc-7.2 the error messages looked like this (notice the wrong +-- indentation): --- Currently the error message looks ok, however +{- +tcfail177.hs:9:12: + Couldn't match expected type `Bool' with actual type `Int' + In the return type of a call of `foo' + In the expression: + foo + ["One........" ~?= "1", "Two" ~?= "2", "Thre........." ~?= "3", + "Four" ~?= "4", ....] + In an equation for `allTest1': + allTest1 + = foo + ["One........" ~?= "1", "Two" ~?= "2", "Thre........." ~?= "3", + ....] -allTests :: Bool -allTests = foo - [a ~?= b - ,"Three" ~?= "3" +tcfail177.hs:18:12: + Couldn't match expected type `Bool' with actual type `Int' + In the return type of a call of `foo' + In the expression: + foo + ["One........" ~?= "1", "Two.................." ~?= "2", + "Thre........." ~?= "3", "Four" ~?= "4", ....] + In an equation for `allTest2': + allTest2 + = foo + ["One........" ~?= "1", "Two.................." ~?= "2", + "Thre........." ~?= "3", ....] +-} + +allTest1 :: Bool +allTest1 = foo + ["One........" ~?= "1" + ,"Two" ~?= "2" + ,"Thre........." ~?= "3" ,"Four" ~?= "4" ,"Five" ~?= "5" - ,"Five" ~?= "5" - ,"Five" ~?= "5" - ,"Five" ~?= "5" - ,"Five" ~?= "5" - ,"Five" ~?= "5" - ,"Two", "Two", "Two" - ,"Two", "Two", "Two" - ,"Two", "Two", "Two" - ,"Two", "Two", "Two" - ,"Two", "Two", "Two" - ,"Two", "Two", "Two"] + ] -a="" -b="" +allTest2 :: Bool +allTest2 = foo + ["One........" ~?= "1" + ,"Two.................." ~?= "2" + ,"Thre........." ~?= "3" + ,"Four" ~?= "4" + ,"Five" ~?= "5" + ] (~?=) :: a -> a -> Bool -(~?=) = error "urk" +(~?=) = error "urk" foo :: a -> Int foo x = 0 diff --git a/testsuite/tests/typecheck/should_fail/tcfail177.stderr b/testsuite/tests/typecheck/should_fail/tcfail177.stderr index 54d7331172..206f9ced6c 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail177.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail177.stderr @@ -1,170 +1,24 @@ -tcfail177.hs:10:12: +tcfail177.hs:38:12: error: Couldn't match expected type ‘Bool’ with actual type ‘Int’ In the expression: foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - In an equation for ‘allTests’: - allTests = foo [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", ....] + ["One........" ~?= "1", "Two" ~?= "2", "Thre........." ~?= "3", + "Four" ~?= "4", ....] + In an equation for ‘allTest1’: + allTest1 + = foo + ["One........" ~?= "1", "Two" ~?= "2", "Thre........." ~?= "3", + ....] -tcfail177.hs:20:13: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:20:20: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:20:27: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:21:13: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:21:20: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:21:27: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:22:13: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:22:20: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:22:27: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:23:13: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:23:20: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:23:27: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:24:13: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:24:20: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:24:27: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:25:13: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:25:20: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ - In the expression: - foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] - -tcfail177.hs:25:27: - Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ - In the expression: "Two" - In the first argument of ‘foo’, namely - ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’ +tcfail177.hs:47:12: error: + Couldn't match expected type ‘Bool’ with actual type ‘Int’ In the expression: foo - [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....] + ["One........" ~?= "1", "Two.................." ~?= "2", + "Thre........." ~?= "3", "Four" ~?= "4", ....] + In an equation for ‘allTest2’: + allTest2 + = foo + ["One........" ~?= "1", "Two.................." ~?= "2", + "Thre........." ~?= "3", ....] |