[commit: ghc] ghc-8.2: Correctly expand lines with multiple tabs (02837ea)

[git at git.haskell.org]

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

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/02837ea502e8c38d8e256251166079504fd03015/ghc

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

commit 02837ea502e8c38d8e256251166079504fd03015
Author: Phil Ruffwind <rf at rufflewind.com>
Date:   Sat May 20 12:48:26 2017 -0400

    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
    
    (cherry picked from commit 86466489a4154d595c408470df68e946a100df88)


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

02837ea502e8c38d8e256251166079504fd03015
 compiler/main/ErrUtils.hs                               | 17 ++++++++++-------
 .../tests/warnings/should_fail/CaretDiagnostics1.hs     |  3 +++
 .../tests/warnings/should_fail/CaretDiagnostics1.stderr |  8 ++++++++
 3 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs
index d87d2b2..b0bbe3c 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 3ebb5ee..baa8a33 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 600b7c7..15dedf0 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 =                ()
+   |                         ^^