Commit 6e202120 authored by Ian Lynagh's avatar Ian Lynagh

Add a warning for tabs in source files

parent cc318c84
......@@ -46,8 +46,9 @@ import Panic
import Constants
import Outputable
import Control.Monad ( when )
import Control.Monad
import Data.Char ( ord )
import System.Exit
#include "HsVersions.h"
}
......@@ -918,9 +919,12 @@ parseCmmFile dflags filename = do
-- in there we don't want.
case unP cmmParse init_state of
PFailed span err -> do printError span err; return Nothing
POk _ code -> do
POk pst code -> do
cmm <- initC dflags no_module (getCmm (unEC code initEnv [] >> return ()))
dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms [cmm])
let ms = getMessages pst
printErrorsAndWarnings dflags ms
when (errorsFound dflags ms) $ exitWith (ExitFailure 1)
dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms [cmm])
return (Just cmm)
where
no_module = panic "parseCmmFile: no module"
......
......@@ -156,6 +156,7 @@ data DynFlag
| Opt_WarnDeprecations
| Opt_WarnDodgyImports
| Opt_WarnOrphans
| Opt_WarnTabs
-- language opts
| Opt_AllowOverlappingInstances
......@@ -1032,6 +1033,7 @@ fFlags = [
( "warn-unused-matches", Opt_WarnUnusedMatches ),
( "warn-deprecations", Opt_WarnDeprecations ),
( "warn-orphans", Opt_WarnOrphans ),
( "warn-tabs", Opt_WarnTabs ),
( "fi", Opt_FFI ), -- support `-ffi'...
( "ffi", Opt_FFI ), -- ...and also `-fffi'
( "arrows", Opt_Arrows ), -- arrow syntax
......
......@@ -15,8 +15,7 @@ module HeaderInfo ( getImportsFromFile, getImports
#include "HsVersions.h"
import Parser ( parseHeader )
import Lexer ( P(..), ParseResult(..), mkPState, pragState
, lexer, Token(..), PState(..) )
import Lexer
import FastString
import HsSyn ( ImportDecl(..), HsModule(..) )
import Module ( ModuleName, moduleName )
......@@ -25,7 +24,7 @@ import StringBuffer ( StringBuffer(..), hGetStringBuffer, hGetStringBufferBlock
, appendStringBuffers )
import SrcLoc
import FastString ( mkFastString )
import DynFlags ( DynFlags )
import DynFlags
import ErrUtils
import Util
import Outputable
......@@ -37,6 +36,8 @@ import Bag ( emptyBag, listToBag )
import Distribution.Compiler
import Control.Exception
import Control.Monad
import System.Exit
import System.IO
import Data.List
......@@ -65,7 +66,10 @@ getImports dflags buf filename = do
let loc = mkSrcLoc (mkFastString filename) 1 0
case unP parseHeader (mkPState buf loc dflags) of
PFailed span err -> parseError span err
POk _ rdr_module ->
POk pst rdr_module -> do
let ms = getMessages pst
printErrorsAndWarnings dflags ms
when (errorsFound dflags ms) $ exitWith (ExitFailure 1)
case rdr_module of
L _ (HsModule mb_mod _ imps _ _ _ _ _) ->
let
......
......@@ -54,7 +54,7 @@ import HsSyn ( HsModule, LHsBinds, HsGroup, LIE, LImportDecl, HsDoc,
import SrcLoc ( Located(..) )
import StringBuffer ( hGetStringBuffer, stringToStringBuffer )
import Parser
import Lexer ( P(..), ParseResult(..), mkPState )
import Lexer
import SrcLoc ( mkSrcLoc )
import TcRnDriver ( tcRnModule, tcRnExtCore )
import TcIface ( typecheckIface )
......@@ -93,6 +93,7 @@ import UniqFM ( emptyUFM )
import Bag ( unitBag )
import Control.Monad
import System.Exit
import System.IO
import Data.IORef
\end{code}
......@@ -737,8 +738,12 @@ myParseModule dflags src_filename maybe_src_buf
PFailed span err -> return (Left (mkPlainErrMsg span err));
POk _ rdr_module -> do {
POk pst rdr_module -> do {
let {ms = getMessages pst};
printErrorsAndWarnings dflags ms;
when (errorsFound dflags ms) $ exitWith (ExitFailure 1);
dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr rdr_module) ;
dumpIfSet_dyn dflags Opt_D_source_stats "Source Statistics"
......@@ -893,7 +898,11 @@ hscParseThing parser dflags str
PFailed span err -> do { printError span err;
return Nothing };
POk _ thing -> do {
POk pst thing -> do {
let {ms = getMessages pst};
printErrorsAndWarnings dflags ms;
when (errorsFound dflags ms) $ exitWith (ExitFailure 1);
--ToDo: can't free the string buffer until we've finished this
-- compilation sweep and all the identifiers have gone away.
......
......@@ -25,6 +25,7 @@ module Lexer (
Token(..), lexer, pragState, mkPState, PState(..),
P(..), ParseResult(..), getSrcLoc,
failLocMsgP, failSpanMsgP, srcParseFail,
getMessages,
popContext, pushCurrentContext, setLastToken, setSrcLoc,
getLexState, popLexState, pushLexState,
extension, glaExtsEnabled, bangPatEnabled
......@@ -32,7 +33,8 @@ module Lexer (
#include "HsVersions.h"
import ErrUtils ( Message )
import Bag
import ErrUtils
import Outputable
import StringBuffer
import FastString
......@@ -43,6 +45,7 @@ import DynFlags
import Ctype
import Util ( maybePrefixMatch, readRational )
import Control.Monad
import Data.Bits
import Data.Char ( chr, isSpace )
import Data.Ratio
......@@ -56,8 +59,9 @@ import Compat.Unicode ( GeneralCategory(..), generalCategory, isPrint, isUpper )
}
$unispace = \x05
$whitechar = [\ \t\n\r\f\v\xa0 $unispace]
$whitechar = [\ \n\r\f\v\xa0 $unispace]
$white_no_nl = $whitechar # \n
$tab = \t
$ascdigit = 0-9
$unidigit = \x03
......@@ -108,6 +112,7 @@ haskell :-
-- everywhere: skip whitespace and comments
$white_no_nl+ ;
$tab+ { warn Opt_WarnTabs (text "Tab character") }
-- Everywhere: deal with nested comments. We explicitly rule out
-- pragmas, "{-#", so that we don't accidentally treat them as comments.
......@@ -1298,6 +1303,14 @@ getCharOrFail = do
Nothing -> lexError "unexpected end-of-file in string/character literal"
Just (c,i) -> do setInput i; return c
-- -----------------------------------------------------------------------------
-- Warnings
warn :: DynFlag -> SDoc -> Action
warn option warning span _buf _len = do
addWarning option (mkWarnMsg span alwaysQualify warning)
lexToken
-- -----------------------------------------------------------------------------
-- The Parse Monad
......@@ -1316,6 +1329,8 @@ data ParseResult a
data PState = PState {
buffer :: StringBuffer,
dflags :: DynFlags,
messages :: Messages,
last_loc :: SrcSpan, -- pos of previous token
last_offs :: !Int, -- offset of the previous token from the
-- beginning of the current line.
......@@ -1500,6 +1515,10 @@ pragState :: StringBuffer -> SrcLoc -> PState
pragState buf loc =
PState {
buffer = buf,
messages = emptyMessages,
-- XXX defaultDynFlags is not right, but we don't have a real
-- dflags handy
dflags = defaultDynFlags,
last_loc = mkSrcSpan loc loc,
last_offs = 0,
last_len = 0,
......@@ -1517,6 +1536,8 @@ mkPState :: StringBuffer -> SrcLoc -> DynFlags -> PState
mkPState buf loc flags =
PState {
buffer = buf,
dflags = flags,
messages = emptyMessages,
last_loc = mkSrcSpan loc loc,
last_offs = 0,
last_len = 0,
......@@ -1543,6 +1564,15 @@ mkPState buf loc flags =
b `setBitIf` cond | cond = bit b
| otherwise = 0
addWarning :: DynFlag -> WarnMsg -> P ()
addWarning option w
= P $ \s@PState{messages=(ws,es), dflags=d} ->
let ws' = if dopt option d then ws `snocBag` w else ws
in POk s{messages=(ws', es)} ()
getMessages :: PState -> Messages
getMessages PState{messages=ms} = ms
getContext :: P [LayoutContext]
getContext = P $ \s@PState{context=ctx} -> POk s ctx
......
......@@ -813,6 +813,13 @@
<entry><option>-fno-warn-simple-patterns</option></entry>
</row>
<row>
<entry><option>-fwarn-tabs</option></entry>
<entry>warn if there are tabs in the source file</entry>
<entry>dynamic</entry>
<entry><option>-fno-warn-tabs</option></entry>
</row>
<row>
<entry><option>-fwarn-type-defaults</option></entry>
<entry>warn when defaulting happens</entry>
......
......@@ -1096,6 +1096,18 @@ f "2" = 2
</listitem>
</varlistentry>
<varlistentry>
<term><option>-fwarn-tabs</option>:</term>
<listitem>
<indexterm><primary><option>-fwarn-tabs</option></primary></indexterm>
<indexterm><primary>tabs, warning</primary></indexterm>
<para>Have the compiler warn if there are tabs in your source
file.</para>
<para>This warning is off by default.</para>
</listitem>
</varlistentry>
<varlistentry>
<term><option>-fwarn-type-defaults</option>:</term>
<listitem>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment