Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
6e202120
Commit
6e202120
authored
Jan 12, 2007
by
Ian Lynagh
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add a warning for tabs in source files
parent
cc318c84
Changes
7
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
80 additions
and
12 deletions
+80
-12
compiler/cmm/CmmParse.y
compiler/cmm/CmmParse.y
+7
-3
compiler/main/DynFlags.hs
compiler/main/DynFlags.hs
+2
-0
compiler/main/HeaderInfo.hs
compiler/main/HeaderInfo.hs
+8
-4
compiler/main/HscMain.lhs
compiler/main/HscMain.lhs
+12
-3
compiler/parser/Lexer.x
compiler/parser/Lexer.x
+32
-2
docs/users_guide/flags.xml
docs/users_guide/flags.xml
+7
-0
docs/users_guide/using.xml
docs/users_guide/using.xml
+12
-0
No files found.
compiler/cmm/CmmParse.y
View file @
6e202120
...
...
@@ -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"
...
...
compiler/main/DynFlags.hs
View file @
6e202120
...
...
@@ -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
...
...
compiler/main/HeaderInfo.hs
View file @
6e202120
...
...
@@ -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
...
...
compiler/main/HscMain.lhs
View file @
6e202120
...
...
@@ -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.
...
...
compiler/parser/Lexer.x
View file @
6e202120
...
...
@@ -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
...
...
docs/users_guide/flags.xml
View file @
6e202120
...
...
@@ -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>
...
...
docs/users_guide/using.xml
View file @
6e202120
...
...
@@ -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>
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment