Commit f3e737bb authored by Sebastian Graf's avatar Sebastian Graf Committed by Marge Bot

Fix long distance info for record updates

For record updates where the `record_expr` is a variable, as in #17783:

```hs
data PartialRec = No
                | Yes { a :: Int, b :: Bool }
update No = No
update r@(Yes {}) = r { b = False }
```

We should make use of long distance info in
`-Wincomplete-record-updates` checking. But the call to `matchWrapper`
in the `RecUpd` case didn't specify a scrutinee expression, which would
correspond to the `record_expr` `r` here. That is fixed now.

Fixes #17783.
parent 00dc0f7e
Pipeline #15638 failed with stages
in 406 minutes and 26 seconds
......@@ -1159,7 +1159,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) vars result
= when (flag_i || flag_u) $ do
unc_examples <- getNFirstUncovered vars (maxPatterns + 1) uncovered
let exists_r = flag_i && notNull redundant
exists_i = flag_i && notNull inaccessible && not is_rec_upd
exists_i = flag_i && notNull inaccessible
exists_u = flag_u && notNull unc_examples
approx = precision == Approximate
......@@ -1182,13 +1182,10 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) vars result
, cr_approx = precision } = result
(redundant, inaccessible) = redundantAndInaccessibleRhss clauses
flag_i = wopt Opt_WarnOverlappingPatterns dflags
flag_i = overlapping dflags kind
flag_u = exhaustive dflags kind
flag_u_reason = maybe NoReason Reason (exhaustiveWarningFlag kind)
is_rec_upd = case kind of { RecUpd -> True; _ -> False }
-- See Note [Inaccessible warnings for record updates]
maxPatterns = maxUncoveredPatterns dflags
-- Print a single clause (for redundant/with-inaccessible-rhs)
......@@ -1244,6 +1241,17 @@ it's impossible:
We don't want to warn about the inaccessible branch because the programmer
didn't put it there! So we filter out the warning here.
The same can happen for long distance term constraints instead of type
constraints (#17783):
data T = A { x :: Int } | B { x :: Int }
f r@A{} = r { x = 3 }
f _ = B 0
Here, the long distance info from the FunRhs match (@r ~ A x@) will make the
clause matching on @B@ of the desugaring to @case@ redundant. It's generated
code that we don't want to warn about.
-}
dots :: Int -> [a] -> SDoc
......@@ -1260,6 +1268,12 @@ allPmCheckWarnings =
, Opt_WarnOverlappingPatterns
]
-- | Check whether the redundancy checker should run (redundancy only)
overlapping :: DynFlags -> HsMatchContext id -> Bool
-- See Note [Inaccessible warnings for record updates]
overlapping _ RecUpd = False
overlapping dflags _ = wopt Opt_WarnOverlappingPatterns dflags
-- | Check whether the exhaustiveness checker should run (exhaustiveness only)
exhaustive :: DynFlags -> HsMatchContext id -> Bool
exhaustive dflags = maybe False (`wopt` dflags) . exhaustiveWarningFlag
......
......@@ -601,7 +601,7 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
-- constructor arguments.
; alts <- mapM (mk_alt upd_fld_env) cons_to_upd
; ([discrim_var], matching_code)
<- matchWrapper RecUpd Nothing
<- matchWrapper RecUpd (Just record_expr) -- See Note [Scrutinee in Record updates]
(MG { mg_alts = noLoc alts
, mg_ext = MatchGroupTc [in_ty] out_ty
, mg_origin = FromSource })
......@@ -707,6 +707,24 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
, pat_wrap = req_wrap }
; return (mkSimpleMatch RecUpd [pat] wrapped_rhs) }
{- Note [Scrutinee in Record updates]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider #17783:
data PartialRec = No
| Yes { a :: Int, b :: Bool }
update No = No
update r@(Yes {}) = r { b = False }
In the context of pattern-match checking, the occurrence of @r@ in
@r { b = False }@ is to be treated as if it was a scrutinee, as can be seen by
the following desugaring:
r { b = False } ==> case r of Yes a b -> Yes a False
Thus, we pass @r@ as the scrutinee expression to @matchWrapper@ above.
-}
-- Here is where we desugar the Template Haskell brackets and escapes
-- Template Haskell stuff
......
{-# OPTIONS_GHC -Wincomplete-record-updates #-}
module Bug where
data PartialRec = No
| Yes { a :: Int, b :: Bool }
update No = No
update r@(Yes {}) = r { b = False }
......@@ -112,6 +112,8 @@ test('T17646', normal, compile,
['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
test('T17703', normal, compile,
['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
test('T17783', normal, compile,
['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
# Other tests
test('pmc001', [], compile,
......
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