[Git][ghc/ghc][master] ApplicativeDo: Set pattern location before running exhaustiveness checker

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
74c767df by Matthew Pickering at 2022-12-02T01:22:48-05:00
ApplicativeDo: Set pattern location before running exhaustiveness checker

This improves the error messages of the exhaustiveness checker when
checking statements which have been moved around with ApplicativeDo.

Before:

Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns]
    Pattern match(es) are non-exhaustive
    In a pattern binding:
        Patterns of type ‘Maybe ()’ not matched: Nothing
  |
2 |   let x = ()
  |   ^^^^^^^^^^

After:

Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns]
    Pattern match(es) are non-exhaustive
    In a pattern binding:
        Patterns of type ‘Maybe ()’ not matched: Nothing
  |
4 |   ~(Just res1) <- seq x (pure $ Nothing @())
  |

Fixes #22483

- - - - -


4 changed files:

- compiler/GHC/HsToCore/Expr.hs
- + testsuite/tests/ado/T22483.hs
- + testsuite/tests/ado/T22483.stderr
- testsuite/tests/ado/all.T


Changes:

=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -714,7 +714,8 @@ dsDo ctx stmts
            ; body' <- dsLExpr $ noLocA $ HsDo body_ty ctx (noLocA stmts)
 
            ; let match_args (pat, fail_op) (vs,body)
-                   = do { var   <- selectSimpleMatchVarL ManyTy pat
+                   = putSrcSpanDs (getLocA pat) $
+                     do { var   <- selectSimpleMatchVarL ManyTy pat
                         ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt ctx)) pat
                                    body_ty (cantFailMatchResult body)
                         ; match_code <- dsHandleMonadicFailure ctx pat match fail_op


=====================================
testsuite/tests/ado/T22483.hs
=====================================
@@ -0,0 +1,7 @@
+main = do
+  let x = ()
+  res2 <- pure ()
+  ~(Just res1) <- seq x (pure $ Nothing @())
+  print res1
+  print res2
+  pure ()


=====================================
testsuite/tests/ado/T22483.stderr
=====================================
@@ -0,0 +1,8 @@
+
+T22483.hs:1:1: warning: [GHC-38417] [-Wmissing-signatures (in -Wall)]
+    Top-level binding with no type signature: main :: IO ()
+
+T22483.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns (in -Wall)]
+    Pattern match(es) are non-exhaustive
+    In a pattern binding:
+        Patterns of type ‘Maybe ()’ not matched: Nothing


=====================================
testsuite/tests/ado/all.T
=====================================
@@ -21,3 +21,4 @@ test('T16628', normal, compile_fail, [''])
 test('T17835', normal, compile, [''])
 test('T20540', normal, compile, [''])
 test('T16135', when(compiler_debugged(),expect_broken(16135)), compile, [''])
+test('T22483', normal, compile, ['-Wall'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74c767df770766d8d52e87b9ff7da10f94620a91

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74c767df770766d8d52e87b9ff7da10f94620a91
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/20221202/95f41b51/attachment-0001.html>