Commit 9caf40e9 authored by Ryan Scott's avatar Ryan Scott
Browse files

Fix #14588 by checking for more bang patterns

Summary:
Commit 37299536
inadvertently removed a check in the parser which rejected
let-bindings with bang patterns, leading to #14588. This fixes it by
creating a `hintBangPat` function to perform this check, and
sprinkling it in the right places.

Test Plan: make test TEST=T14588

Reviewers: bgamari, alanz, simonpj

Reviewed By: bgamari, simonpj

Subscribers: rwbarton, thomie, mpickering, carter

GHC Trac Issues: #14588

Differential Revision: https://phabricator.haskell.org/D4270
parent 1bd91a7a
......@@ -2204,10 +2204,9 @@ decl_no_th :: { LHsDecl GhcPs }
: sigdecl { $1 }
| '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)
-- Turn it all into an expression so that
-- checkPattern can check that bangs are enabled
; l = comb2 $1 $> };
(ann, r) <- checkValDef empty SrcStrict e Nothing $3 ;
hintBangPat (comb2 $1 $2) (unLoc e) ;
-- Depending upon what the pattern looks like we might get either
-- a FunBind or PatBind back from checkValDef. See Note
-- [FunBind vs PatBind]
......
......@@ -53,7 +53,7 @@ module RdrHsSyn (
checkValSigLhs,
checkDoAndIfThenElse,
checkRecordSyntax,
parseErrorSDoc,
parseErrorSDoc, hintBangPat,
splitTilde, splitTildeApps,
-- Help with processing exports
......@@ -855,11 +855,10 @@ checkAPat msg loc e0 = do
SectionR (L lb (HsVar (L _ bang))) e -- (! x)
| bang == bang_RDR
-> do { bang_on <- extension bangPatEnabled
; if bang_on then do { e' <- checkLPat msg e
; addAnnotation loc AnnBang lb
; return (BangPat e') }
else parseErrorSDoc loc (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e0) }
-> do { hintBangPat loc e0
; e' <- checkLPat msg e
; addAnnotation loc AnnBang lb
; return (BangPat e') }
ELazyPat e -> checkLPat msg e >>= (return . LazyPat)
EAsPat n e -> checkLPat msg e >>= (return . AsPat n)
......@@ -1556,6 +1555,14 @@ isImpExpQcWildcard _ = False
parseErrorSDoc :: SrcSpan -> SDoc -> P a
parseErrorSDoc span s = failSpanMsgP span s
-- | Hint about bang patterns, assuming @BangPatterns@ is off.
hintBangPat :: SrcSpan -> HsExpr GhcPs -> P ()
hintBangPat span e = do
bang_on <- extension bangPatEnabled
unless bang_on $
parseErrorSDoc span
(text "Illegal bang-pattern (use BangPatterns):" $$ ppr e)
data SumOrTuple
= Sum ConTag Arity (LHsExpr GhcPs)
| Tuple [LHsTupArg GhcPs]
......
module T14588 where
main = print (let !x = 1 + 2 in x)
T14588.hs:3:19: error:
Illegal bang-pattern (use BangPatterns):
! x
......@@ -102,3 +102,4 @@ test('T8501a', normal, compile_fail, [''])
test('T8501b', normal, compile_fail, [''])
test('T8501c', normal, compile_fail, [''])
test('T12610', normal, compile_fail, [''])
test('T14588', 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