[commit: ghc] master: Resume reporting incomplete pattern matches for record updates (a67ebbe)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/a67ebbecfb10c91bb2793cb2f7d91f25aa23e493/ghc

>---------------------------------------------------------------

commit a67ebbecfb10c91bb2793cb2f7d91f25aa23e493
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Nov 27 14:18:35 2014 +0000

    Resume reporting incomplete pattern matches for record updates
    
    They were being inadvertently suppressed, even if you said -fwarn-incomplete-record-updates
    
    See Trac #5728


>---------------------------------------------------------------

a67ebbecfb10c91bb2793cb2f7d91f25aa23e493
 compiler/deSugar/DsExpr.lhs | 5 ++++-
 compiler/deSugar/Match.lhs  | 2 +-
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index 03544bb..c9134c9 100644
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -490,7 +490,10 @@ dsExpr expr@(RecordUpd record_expr (HsRecFields { rec_flds = fields })
         -- constructor aguments.
         ; alts <- mapM (mk_alt upd_fld_env) cons_to_upd
         ; ([discrim_var], matching_code)
-                <- matchWrapper RecUpd (MG { mg_alts = alts, mg_arg_tys = [in_ty], mg_res_ty = out_ty, mg_origin = Generated })
+                <- matchWrapper RecUpd (MG { mg_alts = alts, mg_arg_tys = [in_ty]
+                                           , mg_res_ty = out_ty, mg_origin = FromSource })
+                                           -- FromSource is not strictly right, but we
+                                           -- want incomplete pattern-match warnings
 
         ; return (add_field_binds field_binds' $
                   bindNonRec discrim_var record_expr' matching_code) }
diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs
index 8bc8a11..3bbb0ec 100644
--- a/compiler/deSugar/Match.lhs
+++ b/compiler/deSugar/Match.lhs
@@ -79,7 +79,7 @@ matchCheck_really dflags ctx@(DsMatchContext hs_ctx _) vars ty qs
        ; match vars ty qs }
   where
     (pats, eqns_shadow) = check qs
-    incomplete = incomplete_flag hs_ctx && (notNull pats)
+    incomplete = incomplete_flag hs_ctx && notNull pats
     shadow     = wopt Opt_WarnOverlappingPatterns dflags
               && notNull eqns_shadow