[Git][ghc/ghc][wip/T22524] Adjust error message for trailing whitespace in as-pattern.

[Jade (@Jade)]

Jade pushed to branch wip/T22524 at Glasgow Haskell Compiler / GHC


Commits:
4ce0d7a8 by Jade at 2024-02-04T11:00:41+01:00
Adjust error message for trailing whitespace in as-pattern.

Fixes #22524

- - - - -


6 changed files:

- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Lexer.x
- testsuite/tests/diagnostic-codes/codes.stdout
- + testsuite/tests/parser/should_fail/SuffixAtFail.hs
- + testsuite/tests/parser/should_fail/SuffixAtFail.stderr
- testsuite/tests/parser/should_fail/all.T


Changes:

=====================================
compiler/GHC/Parser/Errors/Ppr.hs
=====================================
@@ -386,7 +386,8 @@ instance Diagnostic PsMessage where
       -> mkSimpleDecorated $ text "primitive string literal must contain only characters <= \'\\xFF\'"
     PsErrSuffixAT
       -> mkSimpleDecorated $
-           text "Suffix occurrence of @. For an as-pattern, remove the leading whitespace."
+           text "The symbol '@' occurs as a suffix." $$
+           text "For an as-pattern, there must not be any whitespace surrounding '@'."
     PsErrPrecedenceOutOfRange i
       -> mkSimpleDecorated $ text "Precedence out of range: " <> int i
     PsErrSemiColonsInCondExpr c st t se e


=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -1784,6 +1784,21 @@ qvarsym, qconsym :: StringBuffer -> Int -> Token
 qvarsym buf len = ITqvarsym $! splitQualName buf len False
 qconsym buf len = ITqconsym $! splitQualName buf len False
 
+
+errSuffixAt :: PsSpan -> P a
+errSuffixAt span = do
+    input <- getInput
+    failLocMsgP start (go input start) (\srcSpan -> mkPlainErrorMsgEnvelope srcSpan $ PsErrSuffixAT)
+  where
+    start = psRealLoc (psSpanStart span)
+    go inp loc
+      | Just (c, i) <- alexGetChar inp
+      , let next = advanceSrcLoc loc c =
+          if c == ' '
+          then go i next
+          else next
+      | otherwise = loc
+
 -- See Note [Whitespace-sensitive operator parsing]
 varsym :: OpWs -> Action
 varsym opws at OpWsPrefix = sym $ \span exts s ->
@@ -1817,7 +1832,7 @@ varsym opws at OpWsPrefix = sym $ \span exts s ->
          do { warnOperatorWhitespace opws span s
             ; return (ITvarsym s) }
 varsym opws at OpWsSuffix = sym $ \span _ s ->
-  if | s == fsLit "@" -> failMsgP (\srcLoc -> mkPlainErrorMsgEnvelope srcLoc $ PsErrSuffixAT)
+  if | s == fsLit "@" -> errSuffixAt span
      | s == fsLit "." -> return ITdot
      | otherwise ->
          do { warnOperatorWhitespace opws span s


=====================================
testsuite/tests/diagnostic-codes/codes.stdout
=====================================
@@ -34,7 +34,6 @@
 [GHC-90355] is untested (constructor = PsErrLetInFunAppExpr)
 [GHC-01239] is untested (constructor = PsErrIfInFunAppExpr)
 [GHC-04807] is untested (constructor = PsErrProcInFunAppExpr)
-[GHC-33856] is untested (constructor = PsErrSuffixAT)
 [GHC-25078] is untested (constructor = PsErrPrecedenceOutOfRange)
 [GHC-18910] is untested (constructor = PsErrSemiColonsInCondCmd)
 [GHC-66418] is untested (constructor = PsErrParseErrorOnInput)


=====================================
testsuite/tests/parser/should_fail/SuffixAtFail.hs
=====================================
@@ -0,0 +1,3 @@
+module Main where
+
+foo x@    () = ()


=====================================
testsuite/tests/parser/should_fail/SuffixAtFail.stderr
=====================================
@@ -0,0 +1,7 @@
+
+SuffixAtFail.hs:3:6: error: [GHC-33856]
+    The symbol '@' occurs as a suffix.
+    For an as-pattern, there must not be any whitespace surrounding '@'.
+  |
+3 | foo x@    () = ()
+  |      ^^^^^


=====================================
testsuite/tests/parser/should_fail/all.T
=====================================
@@ -219,4 +219,5 @@ test('T20609', normal, compile_fail, [''])
 test('T20609a', normal, compile_fail, [''])
 test('T20609b', normal, compile_fail, [''])
 test('T20609c', normal, compile_fail, [''])
-test('T20609d', normal, compile_fail, [''])
\ No newline at end of file
+test('T20609d', normal, compile_fail, [''])
+test('SuffixAtFail', normal, compile_fail, ['-fdiagnostics-show-caret'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ce0d7a836c66544b40607c5d507f21616419c74

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ce0d7a836c66544b40607c5d507f21616419c74
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240204/c86f91c9/attachment-0001.html>