diff options
-rw-r--r-- | compiler/GHC/Parser/Lexer.x | 45 | ||||
-rw-r--r-- | docs/users_guide/9.6.1-notes.rst | 3 | ||||
-rw-r--r-- | testsuite/tests/parser/should_compile/T19372consym.hs | 15 | ||||
-rw-r--r-- | testsuite/tests/parser/should_compile/T19372consym.stderr | 15 | ||||
-rw-r--r-- | testsuite/tests/parser/should_compile/all.T | 1 |
5 files changed, 63 insertions, 16 deletions
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x index e79fbf28b4..8e2efe48f0 100644 --- a/compiler/GHC/Parser/Lexer.x +++ b/compiler/GHC/Parser/Lexer.x @@ -496,7 +496,7 @@ $tab { warnTab } @qvarsym { idtoken qvarsym } @qconsym { idtoken qconsym } @varsym { with_op_ws varsym } - @consym { consym } + @consym { with_op_ws consym } } -- For the normal boxed literals we need to be careful @@ -1681,7 +1681,7 @@ qconsym buf len = ITqconsym $! splitQualName buf len False -- See Note [Whitespace-sensitive operator parsing] varsym :: OpWs -> Action -varsym OpWsPrefix = sym $ \span exts s -> +varsym opws@OpWsPrefix = sym $ \span exts s -> let warnExtConflict errtok = do { addPsMessage (mkSrcSpanPs span) (PsWarnOperatorWhitespaceExtConflict errtok) ; return (ITvarsym s) } @@ -1709,35 +1709,48 @@ varsym OpWsPrefix = sym $ \span exts s -> | s == fsLit "!" -> return ITbang | s == fsLit "~" -> return ITtilde | otherwise -> - do { addPsMessage - (mkSrcSpanPs span) - (PsWarnOperatorWhitespace s OperatorWhitespaceOccurrence_Prefix) + do { warnOperatorWhitespace opws span s ; return (ITvarsym s) } -varsym OpWsSuffix = sym $ \span _ s -> +varsym opws@OpWsSuffix = sym $ \span _ s -> if | s == fsLit "@" -> failMsgP (\srcLoc -> mkPlainErrorMsgEnvelope srcLoc $ PsErrSuffixAT) | s == fsLit "." -> return ITdot | otherwise -> - do { addPsMessage - (mkSrcSpanPs span) - (PsWarnOperatorWhitespace s OperatorWhitespaceOccurrence_Suffix) + do { warnOperatorWhitespace opws span s ; return (ITvarsym s) } -varsym OpWsTightInfix = sym $ \span exts s -> +varsym opws@OpWsTightInfix = sym $ \span exts s -> if | s == fsLit "@" -> return ITat | s == fsLit ".", OverloadedRecordDotBit `xtest` exts -> return (ITproj False) | s == fsLit "." -> return ITdot | otherwise -> - do { addPsMessage - (mkSrcSpanPs span) - (PsWarnOperatorWhitespace s (OperatorWhitespaceOccurrence_TightInfix)) - ; return (ITvarsym s) } + do { warnOperatorWhitespace opws span s + ; return (ITvarsym s) } varsym OpWsLooseInfix = sym $ \_ _ s -> if | s == fsLit "." -> return ITdot | otherwise -> return $ ITvarsym s -consym :: Action -consym = sym (\_span _exts s -> return $ ITconsym s) +consym :: OpWs -> Action +consym opws = sym $ \span _exts s -> + do { warnOperatorWhitespace opws span s + ; return (ITconsym s) } + +warnOperatorWhitespace :: OpWs -> PsSpan -> FastString -> P () +warnOperatorWhitespace opws span s = + whenIsJust (check_unusual_opws opws) $ \opws' -> + addPsMessage + (mkSrcSpanPs span) + (PsWarnOperatorWhitespace s opws') + +-- Check an operator occurrence for unusual whitespace (prefix, suffix, tight infix). +-- This determines if -Woperator-whitespace is triggered. +check_unusual_opws :: OpWs -> Maybe OperatorWhitespaceOccurrence +check_unusual_opws opws = + case opws of + OpWsPrefix -> Just OperatorWhitespaceOccurrence_Prefix + OpWsSuffix -> Just OperatorWhitespaceOccurrence_Suffix + OpWsTightInfix -> Just OperatorWhitespaceOccurrence_TightInfix + OpWsLooseInfix -> Nothing sym :: (PsSpan -> ExtsBitmap -> FastString -> P Token) -> Action sym con span buf len _buf2 = diff --git a/docs/users_guide/9.6.1-notes.rst b/docs/users_guide/9.6.1-notes.rst index 4d71cda7bc..355fc63838 100644 --- a/docs/users_guide/9.6.1-notes.rst +++ b/docs/users_guide/9.6.1-notes.rst @@ -68,6 +68,9 @@ Compiler - The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included in :extension:`PolyKinds` and :extension:`DataKinds`. +- The :ghc-flag:`-Woperator-whitespace` warning no longer ignores constructor symbols + (operators starting with ``:``). + GHCi ~~~~ diff --git a/testsuite/tests/parser/should_compile/T19372consym.hs b/testsuite/tests/parser/should_compile/T19372consym.hs new file mode 100644 index 0000000000..6a8fd14d50 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T19372consym.hs @@ -0,0 +1,15 @@ +{-# OPTIONS -Woperator-whitespace #-} + +module T19372consym where + +import Data.List.NonEmpty + +a_suffix = \x y -> x: y +a_prefix = \x y -> x :y +a_tight_infix = \x y -> x:y +a_loose_infix = \x y -> x : y -- Only this one should be without a warning. + +b_suffix = \x y -> x:| y +b_prefix = \x y -> x :|y +b_tight_infix = \x y -> x:|y +b_loose_infix = \x y -> x :| y -- Only this one should be without a warning. diff --git a/testsuite/tests/parser/should_compile/T19372consym.stderr b/testsuite/tests/parser/should_compile/T19372consym.stderr new file mode 100644 index 0000000000..f2a0998069 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T19372consym.stderr @@ -0,0 +1,15 @@ + +T19372consym.hs:12:26: warning: [GHC-40798] [-Woperator-whitespace] + The suffix use of a ‘:|’ might be repurposed as special syntax + by a future language extension. + Suggested fix: Add whitespace around ‘:|’. + +T19372consym.hs:13:27: warning: [GHC-40798] [-Woperator-whitespace] + The prefix use of a ‘:|’ might be repurposed as special syntax + by a future language extension. + Suggested fix: Add whitespace around ‘:|’. + +T19372consym.hs:14:26: warning: [GHC-40798] [-Woperator-whitespace] + The tight infix use of a ‘:|’ might be repurposed as special syntax + by a future language extension. + Suggested fix: Add whitespace around ‘:|’. diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T index 53fd222576..5fc2a72566 100644 --- a/testsuite/tests/parser/should_compile/all.T +++ b/testsuite/tests/parser/should_compile/all.T @@ -193,3 +193,4 @@ test('T20718', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-c test('T20718b', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) test('T21589', normal, compile, ['']) +test('T19372consym', normal, compile, ['']) |