summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/HsToCore/Expr.hs3
-rw-r--r--testsuite/tests/ado/T22483.hs7
-rw-r--r--testsuite/tests/ado/T22483.stderr8
-rw-r--r--testsuite/tests/ado/all.T1
4 files changed, 18 insertions, 1 deletions
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 92ab68c5b8..54bd0e45b6 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/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
diff --git a/testsuite/tests/ado/T22483.hs b/testsuite/tests/ado/T22483.hs
new file mode 100644
index 0000000000..31d2f72add
--- /dev/null
+++ b/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 ()
diff --git a/testsuite/tests/ado/T22483.stderr b/testsuite/tests/ado/T22483.stderr
new file mode 100644
index 0000000000..2428c31ea9
--- /dev/null
+++ b/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
diff --git a/testsuite/tests/ado/all.T b/testsuite/tests/ado/all.T
index 7bd416a570..4159ebd8b1 100644
--- a/testsuite/tests/ado/all.T
+++ b/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'])