Commit 7fa53b86 authored by cgibbard's avatar cgibbard

Add some tests for fail messages in do-expressions and monad-comprehensions.

parent ca8e356b
Pipeline #23075 passed with stages
in 392 minutes and 14 seconds
......@@ -988,7 +988,7 @@ dsDo ctx stmts
; var <- selectSimpleMatchVarL (xbstc_boundResultMult xbs) pat
; match <- matchSinglePatVar var (StmtCtxt ctx) pat
(xbstc_boundResultType xbs) (cantFailMatchResult body)
; match_code <- dsHandleMonadicFailure DoExpr pat match (xbstc_failOp xbs)
; match_code <- dsHandleMonadicFailure ctx pat match (xbstc_failOp xbs)
; dsSyntaxExpr (xbstc_bindOp xbs) [rhs', Lam var match_code] }
go _ (ApplicativeStmt body_ty args mb_join) stmts
......@@ -1009,7 +1009,7 @@ dsDo ctx stmts
= do { var <- selectSimpleMatchVarL Many pat
; match <- matchSinglePatVar var (StmtCtxt ctx) pat
body_ty (cantFailMatchResult body)
; match_code <- dsHandleMonadicFailure DoExpr pat match fail_op
; match_code <- dsHandleMonadicFailure ctx pat match fail_op
; return (var:vs, match_code)
}
......
......@@ -618,7 +618,7 @@ dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts
; var <- selectSimpleMatchVarL Many pat
; match <- matchSinglePatVar var (StmtCtxt (DoExpr Nothing)) pat
res1_ty (cantFailMatchResult body)
; match_code <- dsHandleMonadicFailure MonadComp pat match fail_op
; match_code <- dsHandleMonadicFailure (MonadComp :: HsStmtContext GhcRn) pat match fail_op
; dsSyntaxExpr bind_op [rhs', Lam var match_code] }
-- Desugar nested monad comprehensions, for example in `then..` constructs
......
......@@ -898,7 +898,7 @@ CPR-friendly. This matters a lot: if you don't get it right, you lose
the tail call property. For example, see #3403.
-}
dsHandleMonadicFailure :: HsStmtContext GhcTc -> LPat GhcTc -> MatchResult CoreExpr -> FailOperator GhcTc -> DsM CoreExpr
dsHandleMonadicFailure :: Outputable (IdP p) => HsStmtContext p -> LPat GhcTc -> MatchResult CoreExpr -> FailOperator GhcTc -> DsM CoreExpr
-- In a do expression, pattern-match failure just calls
-- the monadic 'fail' rather than throwing an exception
dsHandleMonadicFailure ctx pat match m_fail_op =
......@@ -919,7 +919,7 @@ dsHandleMonadicFailure ctx pat match m_fail_op =
fail_expr <- dsSyntaxExpr fail_op [fail_msg]
body fail_expr
mk_fail_msg :: DynFlags -> HsStmtContext GhcTc -> Located e -> String
mk_fail_msg :: Outputable (IdP p) => DynFlags -> HsStmtContext p -> Located e -> String
mk_fail_msg dflags ctx pat = showPpr dflags $ text "Pattern match failure in" <+> pprStmtContext ctx <+> text "at" <+> ppr (getLoc pat)
{- *********************************************************************
......
main = do
(x:xs) <- return []
return ()
DsDoExprFailMsg: user error (Pattern match failure in 'do' block at DsDoExprFailMsg.hs:2:3-8)
{-# LANGUAGE MonadComprehensions #-}
main = [() | (x:xs) <- return []]
DsMonadCompFailMsg: user error (Pattern match failure in monad comprehension at DsMonadCompFailMsg.hs:2:14-19)
......@@ -66,3 +66,6 @@ test('T12595', normal, compile_and_run, [''])
test('T13285', normal, compile_and_run, [''])
test('T18151', normal, compile_and_run, [''])
test('T18172', [], ghci_script, ['T18172.script'])
test('DsDoExprFailMsg', exit_code(1), compile_and_run, [''])
test('DsMonadCompFailMsg', exit_code(1), compile_and_run, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment