summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDave Laing <dave.laing.80@gmail.com>2015-04-02 11:50:54 +0200
committerThomas Miedema <thomasmiedema@gmail.com>2015-04-02 11:51:00 +0200
commitd355b1d6c05d103104667a285082bc7851f37548 (patch)
treede03eec1cfc363eb74c8f2ece722f5e3ef2b6069
parent4c1e1c870e294990a44d8d6837742fb0d00f5456 (diff)
downloadhaskell-wip/T9723.tar.gz
Changes 'Tab character' warnings so there is one per file (#9723)wip/T9723
Reviewed By: thomie, nomeata Differential Revision: https://phabricator.haskell.org/D760 Signed-off-by: Dave Laing <dave.laing.80@gmail.com>
-rw-r--r--compiler/parser/Lexer.x38
-rw-r--r--testsuite/tests/driver/werror.stderr2
-rw-r--r--testsuite/tests/parser/should_compile/T9723a.hs9
-rw-r--r--testsuite/tests/parser/should_compile/T9723a.stderr3
-rw-r--r--testsuite/tests/parser/should_compile/T9723b.hs21
-rw-r--r--testsuite/tests/parser/should_compile/T9723b.stderr3
-rw-r--r--testsuite/tests/parser/should_compile/all.T2
-rw-r--r--testsuite/tests/parser/should_compile/read043.stderr3
-rw-r--r--testsuite/tests/warnings/should_compile/T9230.stderr2
9 files changed, 77 insertions, 6 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index abb2477783..d26d9ec407 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,33 @@ 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@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 ". Please use spaces instead."
+ in fmap (\s -> mkWarnMsg d (RealSrcSpan s) alwaysQualify message) tf
+
getMessages :: PState -> Messages
-getMessages PState{messages=ms} = ms
+getMessages p@PState{messages=(ws,es)} =
+ let tabwarning = mkTabWarning p
+ ws' = maybe ws (`consBag` ws) tabwarning
+ in (ws', es)
getContext :: P [LayoutContext]
getContext = P $ \s@PState{context=ctx} -> POk s ctx
diff --git a/testsuite/tests/driver/werror.stderr b/testsuite/tests/driver/werror.stderr
index b723c39364..47213f9d87 100644
--- a/testsuite/tests/driver/werror.stderr
+++ b/testsuite/tests/driver/werror.stderr
@@ -8,7 +8,7 @@ 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/T9723a.hs b/testsuite/tests/parser/should_compile/T9723a.hs
new file mode 100644
index 0000000000..b75944ab18
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T9723a.hs
@@ -0,0 +1,9 @@
+
+{-# OPTIONS -fwarn-tabs #-}
+
+-- Check we get a warning for a single tab
+
+module ShouldCompile where
+
+tab1 = 'a'
+
diff --git a/testsuite/tests/parser/should_compile/T9723a.stderr b/testsuite/tests/parser/should_compile/T9723a.stderr
new file mode 100644
index 0000000000..4024df388f
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T9723a.stderr
@@ -0,0 +1,3 @@
+
+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 0000000000..22bc2da09d
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T9723b.hs
@@ -0,0 +1,21 @@
+
+{-# 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 0000000000..c76be2043d
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T9723b.stderr
@@ -0,0 +1,3 @@
+
+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 13acedf014..6eb593a94c 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 dc1e84466a..c6024511f1 100644
--- a/testsuite/tests/parser/should_compile/read043.stderr
+++ b/testsuite/tests/parser/should_compile/read043.stderr
@@ -1,4 +1,3 @@
-read043.hs:8:5: Warning: Tab character
+read043.hs:8:5: Warning: Tab character found here, and in one further location. Please use spaces instead.
-read043.hs:10:5: Warning: Tab character
diff --git a/testsuite/tests/warnings/should_compile/T9230.stderr b/testsuite/tests/warnings/should_compile/T9230.stderr
index 09e1f647ed..e62b9dce54 100644
--- a/testsuite/tests/warnings/should_compile/T9230.stderr
+++ b/testsuite/tests/warnings/should_compile/T9230.stderr
@@ -1,2 +1,2 @@
-T9230.hs:5:1: Warning: Tab character
+T9230.hs:5:1: Warning: Tab character found here. Please use spaces instead.