From ead3f835e24338fb3df3ebdec3e86f9364df7c9c Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Thu, 2 May 2019 07:42:16 +0300 Subject: 'warnSpaceAfterBang' only in patterns (#16619) --- compiler/parser/Parser.y | 21 ++------------------- compiler/parser/RdrHsSyn.hs | 21 ++++++++++++++++----- testsuite/tests/parser/should_compile/T16619.hs | 8 ++++++++ testsuite/tests/parser/should_compile/T16619a.hs | 3 +++ testsuite/tests/parser/should_compile/all.T | 1 + 5 files changed, 30 insertions(+), 24 deletions(-) create mode 100644 testsuite/tests/parser/should_compile/T16619.hs create mode 100644 testsuite/tests/parser/should_compile/T16619a.hs diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 80e197e039..e6f639edb3 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -2601,14 +2601,8 @@ infixexp_top :: { ECP } $2 >>= \ $2 -> runECP_PV $1 >>= \ $1 -> runECP_PV $3 >>= \ $3 -> - do { when (srcSpanEnd (getLoc $2) - == srcSpanStart (getLoc $3) - && checkIfBang (unLoc $2)) $ - warnSpaceAfterBang (comb2 $2 $3); - amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3) - [mj AnnVal $2] - } - } + amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3) + [mj AnnVal $2] } exp10_top :: { ECP } : '-' fexp { ECP $ @@ -3963,17 +3957,6 @@ hintExplicitForall tok = do where forallSymDoc = text (forallSym (isUnicode tok)) --- | Warn about missing space after bang -warnSpaceAfterBang :: SrcSpan -> PV () -warnSpaceAfterBang span = do - bang_on <- getBit BangPatBit - unless bang_on $ - addWarning Opt_WarnSpaceAfterBang span msg - where - msg = text "Did you forget to enable BangPatterns?" $$ - text "If you mean to bind (!) then perhaps you want" $$ - text "to add a space after the bang for clarity." - -- When two single quotes don't followed by tyvar or gtycon, we report the -- error as empty character literal, or TH quote that missing proper type -- variable or constructor. See #13450. diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 8d15cb317b..7c457f83d1 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -1847,20 +1847,16 @@ ecpFromCmd a = ECP (ecpFromCmd' a) -- | Disambiguate infix operators. -- See Note [Ambiguous syntactic categories] class DisambInfixOp b where - checkIfBang :: b -> Bool mkHsVarOpPV :: Located RdrName -> PV (Located b) mkHsConOpPV :: Located RdrName -> PV (Located b) mkHsInfixHolePV :: SrcSpan -> PV (Located b) instance p ~ GhcPs => DisambInfixOp (HsExpr p) where - checkIfBang (HsVar _ (unLoc -> op)) = isBangRdr op - checkIfBang _ = False mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExt v) mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExt v) mkHsInfixHolePV l = return $ cL l hsHoleExpr instance DisambInfixOp RdrName where - checkIfBang = isBangRdr mkHsConOpPV (dL->L l v) = return $ cL l v mkHsVarOpPV (dL->L l v) = return $ cL l v mkHsInfixHolePV l = @@ -2132,7 +2128,9 @@ instance p ~ GhcPs => DisambECP (PatBuilder p) where mkHsLetPV l _ _ = addFatalError l $ text "(let ... in ...)-syntax in pattern" type InfixOp (PatBuilder p) = RdrName superInfixOp m = m - mkHsOpAppPV l p1 op p2 = return $ cL l $ PatBuilderOpApp p1 op p2 + mkHsOpAppPV l p1 op p2 = do + warnSpaceAfterBang op (getLoc p2) + return $ cL l $ PatBuilderOpApp p1 op p2 mkHsCasePV l _ _ = addFatalError l $ text "(case ... of ...)-syntax in pattern" type FunArg (PatBuilder p) = PatBuilder p superFunArg m = m @@ -2193,6 +2191,19 @@ mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd) mkPatRec p _ = addFatalError (getLoc p) $ text "Not a record constructor:" <+> ppr p +-- | Warn about missing space after bang +warnSpaceAfterBang :: Located RdrName -> SrcSpan -> PV () +warnSpaceAfterBang (dL->L opLoc op) argLoc = do + bang_on <- getBit BangPatBit + when (not bang_on && noSpace && isBangRdr op) $ + addWarning Opt_WarnSpaceAfterBang span msg + where + span = combineSrcSpans opLoc argLoc + noSpace = srcSpanEnd opLoc == srcSpanStart argLoc + msg = text "Did you forget to enable BangPatterns?" $$ + text "If you mean to bind (!) then perhaps you want" $$ + text "to add a space after the bang for clarity." + {- Note [Ambiguous syntactic categories] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/testsuite/tests/parser/should_compile/T16619.hs b/testsuite/tests/parser/should_compile/T16619.hs new file mode 100644 index 0000000000..296e23cc9a --- /dev/null +++ b/testsuite/tests/parser/should_compile/T16619.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS -Wmissing-space-after-bang #-} + +module T16619 where + +import T16619a + +1!2 diff --git a/testsuite/tests/parser/should_compile/T16619a.hs b/testsuite/tests/parser/should_compile/T16619a.hs new file mode 100644 index 0000000000..e1af0d3ae6 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T16619a.hs @@ -0,0 +1,3 @@ +module T16619a where + +(!) _ _ = return [] diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T index 1c5c225d65..4fdc359f13 100644 --- a/testsuite/tests/parser/should_compile/all.T +++ b/testsuite/tests/parser/should_compile/all.T @@ -142,3 +142,4 @@ test('T15457', normal, compile, ['']) test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) +test('T16619', [], multimod_compile, ['T16619', '-v0']) -- cgit v1.2.1