summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhil Ruffwind <rf@rufflewind.com>2017-05-20 12:48:26 -0400
committerBen Gamari <ben@smart-cactus.org>2017-05-20 16:29:18 -0400
commit86466489a4154d595c408470df68e946a100df88 (patch)
tree9f4178c04a257d424f1d103d06b181cce0f2b76b
parent80d5190630a975dfa03d1d84d23cdee4f950d58d (diff)
downloadhaskell-86466489a4154d595c408470df68e946a100df88.tar.gz
Correctly expand lines with multiple tabs
rwbarton pointed out that tab expansions can affect the column numbers of subsequent characters, so a unstateful map + zip won't do. This commit hopefully fixes that. It also adds a test for this particular case. Test Plan: validate Reviewers: bgamari, rwbarton, austin Reviewed By: bgamari Subscribers: dfeuer, thomie Differential Revision: https://phabricator.haskell.org/D3578
-rw-r--r--compiler/main/ErrUtils.hs17
-rw-r--r--testsuite/tests/warnings/should_fail/CaretDiagnostics1.hs3
-rw-r--r--testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr8
3 files changed, 21 insertions, 7 deletions
diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs
index d87d2b22aa..b0bbe3c9e4 100644
--- a/compiler/main/ErrUtils.hs
+++ b/compiler/main/ErrUtils.hs
@@ -278,13 +278,16 @@ getCaretDiagnostic severity (RealSrcSpan span) = do
where
- fixWhitespace (i, c)
- | c == '\n' = ""
- -- show tabs in a device-independent manner #13664
- | c == '\t' = replicate (8 - i `mod` 8) ' '
- | otherwise = [c]
-
- srcLine = concat (map fixWhitespace (zip [0..] srcLineWithNewline))
+ -- expand tabs in a device-independent manner #13664
+ expandTabs tabWidth i s =
+ case s of
+ "" -> ""
+ '\t' : cs -> replicate effectiveWidth ' ' ++
+ expandTabs tabWidth (i + effectiveWidth) cs
+ c : cs -> c : expandTabs tabWidth (i + 1) cs
+ where effectiveWidth = tabWidth - i `mod` tabWidth
+
+ srcLine = filter (/= '\n') (expandTabs 8 0 srcLineWithNewline)
start = srcSpanStartCol span - 1
end | multiline = length srcLine
diff --git a/testsuite/tests/warnings/should_fail/CaretDiagnostics1.hs b/testsuite/tests/warnings/should_fail/CaretDiagnostics1.hs
index 3ebb5ee965..baa8a332e2 100644
--- a/testsuite/tests/warnings/should_fail/CaretDiagnostics1.hs
+++ b/testsuite/tests/warnings/should_fail/CaretDiagnostics1.hs
@@ -18,3 +18,6 @@ fóo = ()
tabby :: Int
tabby = ()
+
+tabby2 :: Int
+tabby2 = ()
diff --git a/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr b/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
index 600b7c78d3..15dedf0516 100644
--- a/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
+++ b/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
@@ -78,3 +78,11 @@ CaretDiagnostics1.hs:20:17-18: error:
|
20 | tabby = ()
| ^^
+
+CaretDiagnostics1.hs:23:25-26: error:
+ • Couldn't match expected type ‘Int’ with actual type ‘()’
+ • In the expression: ()
+ In an equation for ‘tabby2’: tabby2 = ()
+ |
+23 | tabby2 = ()
+ | ^^