[commit: ghc] wip/T9723: Change 'Tab character' warnings so there is one per file (#9723) (afcfb62)

git at git.haskell.org git at git.haskell.org
Thu Apr 2 16:58:16 UTC 2015


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

On branch  : wip/T9723
Link       : http://ghc.haskell.org/trac/ghc/changeset/afcfb62b748c41d31b8c8e3ef7f623fa00a1cfd2/ghc

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

commit afcfb62b748c41d31b8c8e3ef7f623fa00a1cfd2
Author: Dave Laing <dave.laing.80 at gmail.com>
Date:   Thu Apr 2 18:51:46 2015 +0200

    Change 'Tab character' warnings so there is one per file (#9723)
    
    Reviewed By: nomeata, thomie
    
    Differential Revision: https://phabricator.haskell.org/D760
    
    Signed-off-by: Dave Laing <dave.laing.80 at gmail.com>


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

afcfb62b748c41d31b8c8e3ef7f623fa00a1cfd2
 compiler/parser/Lexer.x                            | 39 ++++++++++++++++++++--
 testsuite/tests/driver/werror.stderr               |  4 ++-
 .../should_compile/{read043.hs => T9723a.hs}       |  4 +--
 .../tests/parser/should_compile/T9723a.stderr      |  4 +++
 testsuite/tests/parser/should_compile/T9723b.hs    | 22 ++++++++++++
 .../tests/parser/should_compile/T9723b.stderr      |  4 +++
 testsuite/tests/parser/should_compile/all.T        |  2 ++
 .../tests/parser/should_compile/read043.stderr     |  6 ++--
 .../tests/warnings/should_compile/T9230.stderr     |  4 ++-
 9 files changed, 79 insertions(+), 10 deletions(-)

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index abb2477..e451b5f 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -203,7 +203,7 @@ haskell :-
 
 -- everywhere: skip whitespace
 $white_no_nl+ ;
-$tab+         { warn Opt_WarnTabs (text "Tab character") }
+$tab          { warnTab }
 
 -- Everywhere: deal with nested comments.  We explicitly rule out
 -- pragmas, "{-#", so that we don't accidentally treat them as comments.
@@ -1655,6 +1655,11 @@ warn option warning srcspan _buf _len = do
     addWarning option (RealSrcSpan srcspan) warning
     lexToken
 
+warnTab :: Action
+warnTab srcspan _buf _len = do
+    addTabWarning srcspan
+    lexToken
+
 warnThen :: WarningFlag -> SDoc -> Action -> Action
 warnThen option warning action srcspan buf len = do
     addWarning option (RealSrcSpan srcspan) warning
@@ -1680,6 +1685,8 @@ data PState = PState {
         buffer     :: StringBuffer,
         dflags     :: DynFlags,
         messages   :: Messages,
+        tab_first  :: Maybe RealSrcSpan, -- pos of first tab warning in the file
+        tab_count  :: !Int,              -- number of tab warnings in the file
         last_tk    :: Maybe Token,
         last_loc   :: RealSrcSpan, -- pos of previous token
         last_len   :: !Int,        -- len of previous token
@@ -2083,6 +2090,8 @@ mkPState flags buf loc =
       buffer        = buf,
       dflags        = flags,
       messages      = emptyMessages,
+      tab_first     = Nothing,
+      tab_count     = 0,
       last_tk       = Nothing,
       last_loc      = mkRealSrcSpan loc loc,
       last_len      = 0,
@@ -2146,8 +2155,34 @@ addWarning option srcspan warning
            ws' = if wopt option d then ws `snocBag` warning' else ws
        in POk s{messages=(ws', es)} ()
 
+addTabWarning :: RealSrcSpan -> P ()
+addTabWarning srcspan
+ = P $ \s at PState{tab_first=tf, tab_count=tc, dflags=d} ->
+       let tf' = if isJust tf then tf else Just srcspan
+           tc' = tc + 1
+           s' = if wopt Opt_WarnTabs d
+                then s{tab_first = tf', tab_count = tc'}
+                else s
+       in POk s' ()
+addTabWarning _
+  = P $ \s -> POk s ()
+
+mkTabWarning :: PState -> Maybe ErrMsg
+mkTabWarning PState{tab_first=tf, tab_count=tc, dflags=d} =
+  let middle = if tc == 1
+        then text ""
+        else text ", and in" <+> speakNOf (tc - 1) (text "further location")
+      message = text "Tab character found here"
+                <> middle
+                <> text "."
+                $+$ text "Please use spaces instead."
+  in fmap (\s -> mkWarnMsg d (RealSrcSpan s) alwaysQualify message) tf
+
 getMessages :: PState -> Messages
-getMessages PState{messages=ms} = ms
+getMessages p at PState{messages=(ws,es)} =
+  let tabwarning = mkTabWarning p
+      ws' = maybe ws (`consBag` ws) tabwarning
+  in (ws', es)
 
 getContext :: P [LayoutContext]
 getContext = P $ \s at PState{context=ctx} -> POk s ctx
diff --git a/testsuite/tests/driver/werror.stderr b/testsuite/tests/driver/werror.stderr
index b723c39..5541dfc 100644
--- a/testsuite/tests/driver/werror.stderr
+++ b/testsuite/tests/driver/werror.stderr
@@ -8,7 +8,9 @@ werror.hs:7:13: Warning:
 
 werror.hs:7:13: Warning: Defined but not used: ‘main’
 
-werror.hs:8:1: Warning: Tab character
+werror.hs:8:1: Warning:
+    Tab character found here.
+    Please use spaces instead.
 
 werror.hs:10:1: Warning: Defined but not used: ‘f’
 
diff --git a/testsuite/tests/parser/should_compile/read043.hs b/testsuite/tests/parser/should_compile/T9723a.hs
similarity index 54%
copy from testsuite/tests/parser/should_compile/read043.hs
copy to testsuite/tests/parser/should_compile/T9723a.hs
index c663a75..b75944a 100644
--- a/testsuite/tests/parser/should_compile/read043.hs
+++ b/testsuite/tests/parser/should_compile/T9723a.hs
@@ -1,11 +1,9 @@
 
 {-# OPTIONS -fwarn-tabs #-}
 
--- Check we get a warning for tabs
+-- Check we get a warning for a single tab
 
 module ShouldCompile where
 
 tab1	= 'a'
-notab   = 'b'
-tab2	= 'c'
 
diff --git a/testsuite/tests/parser/should_compile/T9723a.stderr b/testsuite/tests/parser/should_compile/T9723a.stderr
new file mode 100644
index 0000000..c445de1
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T9723a.stderr
@@ -0,0 +1,4 @@
+
+T9723a.hs:8:5: Warning:
+    Tab character found here.
+    Please use spaces instead.
diff --git a/testsuite/tests/parser/should_compile/T9723b.hs b/testsuite/tests/parser/should_compile/T9723b.hs
new file mode 100644
index 0000000..d84e24c
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T9723b.hs
@@ -0,0 +1,22 @@
+
+{-# OPTIONS -fwarn-tabs #-}
+
+-- Check we get a warning for multiple tabs, with the correct number of tabs
+-- mentioned
+
+module ShouldCompile where
+
+-- tab in middle of line
+tab1	= 'a'
+-- tab at end of line
+tab2 = 'b'	
+-- two tabs in middle of line
+tab3		= 'c'
+
+tab4 = if True
+-- tab at start of line
+	then 'd'
+-- tab at start of line
+	else 'e'
+
+	-- tab before a comment starts
diff --git a/testsuite/tests/parser/should_compile/T9723b.stderr b/testsuite/tests/parser/should_compile/T9723b.stderr
new file mode 100644
index 0000000..2526450
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T9723b.stderr
@@ -0,0 +1,4 @@
+
+T9723b.hs:9:5: Warning:
+    Tab character found here, and in six further locations.
+    Please use spaces instead.
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index 13acedf..6eb593a 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -98,3 +98,5 @@ test('T7118', normal, compile, [''])
 test('T7776', normal, compile, [''])
 test('RdrNoStaticPointers01', when(compiler_lt('ghc', '7.9'), skip), compile, [''])
 test('T5682', normal, compile, [''])
+test('T9723a', normal, compile, [''])
+test('T9723b', normal, compile, [''])
diff --git a/testsuite/tests/parser/should_compile/read043.stderr b/testsuite/tests/parser/should_compile/read043.stderr
index dc1e844..76b1fb4 100644
--- a/testsuite/tests/parser/should_compile/read043.stderr
+++ b/testsuite/tests/parser/should_compile/read043.stderr
@@ -1,4 +1,4 @@
 
-read043.hs:8:5: Warning: Tab character
-
-read043.hs:10:5: Warning: Tab character
+read043.hs:8:5: Warning:
+    Tab character found here, and in one further location.
+    Please use spaces instead.
diff --git a/testsuite/tests/warnings/should_compile/T9230.stderr b/testsuite/tests/warnings/should_compile/T9230.stderr
index 09e1f64..2c7cee0 100644
--- a/testsuite/tests/warnings/should_compile/T9230.stderr
+++ b/testsuite/tests/warnings/should_compile/T9230.stderr
@@ -1,2 +1,4 @@
 
-T9230.hs:5:1: Warning: Tab character
+T9230.hs:5:1: Warning:
+    Tab character found here.
+    Please use spaces instead.



More information about the ghc-commits mailing list