Commit eeabeb92 authored by Vladislav Zavialov's avatar Vladislav Zavialov Committed by Marge Bot

Report multiple errors

parent 8dcd00ce
......@@ -57,7 +57,7 @@ module Lexer (
activeContext, nextIsEOF,
getLexState, popLexState, pushLexState,
ExtBits(..), getBit,
addWarning,
addWarning, addError,
lexTokenStream,
addAnnotation,AddAnn,addAnnsAt,mkParensApiAnn,
commentToAnnotation
......@@ -2479,6 +2479,17 @@ mkPStatePure options buf loc =
annotations_comments = []
}
addError :: SrcSpan -> SDoc -> P ()
addError srcspan msg
= P $ \s@PState{messages=m} ->
let
m' d =
let (ws, es) = m d
errormsg = mkErrMsg d srcspan alwaysQualify msg
es' = es `snocBag` errormsg
in (ws, es')
in POk s{messages=m'} ()
addWarning :: WarningFlag -> SrcSpan -> SDoc -> P ()
addWarning option srcspan warning
= P $ \s@PState{messages=m, options=o} ->
......
......@@ -884,7 +884,7 @@ checkDatatypeContext Nothing = return ()
checkDatatypeContext (Just c)
= do allowed <- getBit DatatypeContextsBit
unless allowed $
parseErrorSDoc (getLoc c)
addError (getLoc c)
(text "Illegal datatype context (use DatatypeContexts):"
<+> pprLHsContext c)
......@@ -921,11 +921,9 @@ checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)
checkRecordSyntax :: Outputable a => Located a -> P (Located a)
checkRecordSyntax lr@(dL->L loc r)
= do allowed <- getBit TraditionalRecordSyntaxBit
if allowed
then return lr
else parseErrorSDoc loc
(text "Illegal record syntax (use TraditionalRecordSyntax):"
<+> ppr r)
unless allowed $ addError loc $
text "Illegal record syntax (use TraditionalRecordSyntax):" <+> ppr r
return lr
-- | Check if the gadt_constrlist is empty. Only raise parse error for
-- `data T where` to avoid affecting existing error message, see #8258.
......@@ -933,13 +931,12 @@ checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs])
-> P (Located ([AddAnn], [LConDecl GhcPs]))
checkEmptyGADTs gadts@(dL->L span (_, [])) -- Empty GADT declaration.
= do gadtSyntax <- getBit GadtSyntaxBit -- GADTs implies GADTSyntax
if gadtSyntax
then return gadts
else parseErrorSDoc span $ vcat
[ text "Illegal keyword 'where' in data declaration"
, text "Perhaps you intended to use GADTs or a similar language"
, text "extension to enable syntax: data T where"
]
unless gadtSyntax $ addError span $ vcat
[ text "Illegal keyword 'where' in data declaration"
, text "Perhaps you intended to use GADTs or a similar language"
, text "extension to enable syntax: data T where"
]
return gadts
checkEmptyGADTs gadts = return gadts -- Ordinary GADT declaration.
checkTyClHdr :: Bool -- True <=> class header
......@@ -999,7 +996,7 @@ checkBlockArguments expr = case unLoc expr of
check element = do
blockArguments <- getBit BlockArgumentsBit
unless blockArguments $
parseErrorSDoc (getLoc expr) $
addError (getLoc expr) $
text "Unexpected " <> text element <> text " in function application:"
$$ nest 4 (ppr expr)
$$ text "You could write it with parentheses"
......@@ -1041,7 +1038,7 @@ checkNoDocs msg ty = go ty
where
go (dL->L _ (HsAppKindTy _ ty ki)) = go ty *> go ki
go (dL->L _ (HsAppTy _ t1 t2)) = go t1 *> go t2
go (dL->L l (HsDocTy _ t ds)) = parseErrorSDoc l $ hsep
go (dL->L l (HsDocTy _ t ds)) = addError l $ hsep
[ text "Unexpected haddock", quotes (ppr ds)
, text "on", msg, quotes (ppr t) ]
go _ = pure ()
......@@ -1288,7 +1285,7 @@ checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
| semiThen || semiElse
= do doAndIfThenElse <- getBit DoAndIfThenElseBit
unless doAndIfThenElse $ do
parseErrorSDoc (combineLocs guardExpr elseExpr)
addError (combineLocs guardExpr elseExpr)
(text "Unexpected semi-colons in conditional:"
$$ nest 4 expr
$$ text "Perhaps you meant to use DoAndIfThenElse?")
......@@ -2209,10 +2206,9 @@ mkTypeImpExp :: Located RdrName -- TcCls or Var name space
-> P (Located RdrName)
mkTypeImpExp name =
do allowed <- getBit ExplicitNamespacesBit
if allowed
then return (fmap (`setRdrNameSpace` tcClsName) name)
else parseErrorSDoc (getLoc name)
(text "Illegal keyword 'type' (use ExplicitNamespaces to enable)")
unless allowed $ addError (getLoc name) $
text "Illegal keyword 'type' (use ExplicitNamespaces to enable)"
return (fmap (`setRdrNameSpace` tcClsName) name)
checkImportSpec :: Located [LIE GhcPs] -> P (Located [LIE GhcPs])
checkImportSpec ie@(dL->L _ specs) =
......
{-# LANGUAGE NoTraditionalRecordSyntax, NoDoAndIfThenElse #-}
-- module T16270 (type G) where
--
-- ^ Uncommenting this line prevents other errors from printing
-- because HeaderInfo.getImports fails fast on parsing imports:
--
-- if errorsFound dflags ms
-- then throwIO $ mkSrcErr errs
--
-- :(
c = do
if c then
False
else
True
f = id do { 1 }
g = id \x -> x
data Num a => D a
data Pair a b = Pair { fst :: a, snd :: b }
t = p { fst = 1, snd = True }
z = if True; then (); else ();
data G a where
T16270.hs:14:6: error:
Unexpected semi-colons in conditional:
if c then False; else True
Perhaps you meant to use DoAndIfThenElse?
T16270.hs:19:8: error:
Unexpected do block in function application:
do 1
You could write it with parentheses
Or perhaps you meant to enable BlockArguments?
T16270.hs:20:8: error:
Unexpected lambda expression in function application:
\ x -> x
You could write it with parentheses
Or perhaps you meant to enable BlockArguments?
T16270.hs:22:6: error:
Illegal datatype context (use DatatypeContexts): Num a =>
T16270.hs:24:22: error:
Illegal record syntax (use TraditionalRecordSyntax): {fst :: a,
snd :: b}
T16270.hs:25:5: error:
Illegal record syntax (use TraditionalRecordSyntax): p {fst = 1,
snd = True}
T16270.hs:27:8: error:
Unexpected semi-colons in conditional:
if True; then (); else ()
Perhaps you meant to use DoAndIfThenElse?
T16270.hs:29:10: error:
Illegal keyword 'where' in data declaration
Perhaps you intended to use GADTs or a similar language
extension to enable syntax: data T where
......@@ -140,3 +140,4 @@ test('strictnessDataCon_B', normal, compile_fail, [''])
test('unpack_empty_type', normal, compile_fail, [''])
test('unpack_inside_type', normal, compile_fail, [''])
test('unpack_before_opr', normal, compile_fail, [''])
test('T16270', normal, compile_fail, [''])
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