[commit: ghc] wip/T13644: Identify fields by selector when type-checking patterns (fixes #13644) (52110a7)

[git at git.haskell.org]

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

On branch  : wip/T13644
Link       : http://ghc.haskell.org/trac/ghc/changeset/52110a7966848538583acb65f6e064aadc751260/ghc

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

commit 52110a7966848538583acb65f6e064aadc751260
Author: Adam Gundry <adam at well-typed.com>
Date:   Thu Sep 14 15:39:23 2017 +0100

    Identify fields by selector when type-checking patterns (fixes #13644)


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

52110a7966848538583acb65f6e064aadc751260
 compiler/typecheck/TcPat.hs              | 9 +++++----
 testsuite/tests/rename/should_fail/all.T | 2 +-
 2 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs
index 6be2a4e..8dbec2d 100644
--- a/compiler/typecheck/TcPat.hs
+++ b/compiler/typecheck/TcPat.hs
@@ -983,14 +983,15 @@ tcConArgs con_like arg_tys (RecCon (HsRecFields rpats dd)) penv thing_inside
     tc_field (L l (HsRecField (L loc (FieldOcc (L lr rdr) sel)) pat pun)) penv
                                                                     thing_inside
       = do { sel'   <- tcLookupId sel
-           ; pat_ty <- setSrcSpan loc $ find_field_ty (occNameFS $ rdrNameOcc rdr)
+           ; pat_ty <- setSrcSpan loc $ find_field_ty sel
+                                          (occNameFS $ rdrNameOcc rdr)
            ; (pat', res) <- tcConArg (pat, pat_ty) penv thing_inside
            ; return (L l (HsRecField (L loc (FieldOcc (L lr rdr) sel')) pat'
                                                                     pun), res) }
 
-    find_field_ty :: FieldLabelString -> TcM TcType
-    find_field_ty lbl
-        = case [ty | (fl, ty) <- field_tys, flLabel fl == lbl] of
+    find_field_ty :: Name -> FieldLabelString -> TcM TcType
+    find_field_ty sel lbl
+        = case [ty | (fl, ty) <- field_tys, flSelector fl == sel] of
 
                 -- No matching field; chances are this field label comes from some
                 -- other record type (or maybe none).  If this happens, just fail,
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index f7f7719..a98d127 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -125,6 +125,6 @@ test('T12681', normal, multimod_compile_fail, ['T12681','-v0'])
 test('T12686', normal, compile_fail, [''])
 test('T11592', normal, compile_fail, [''])
 test('T12879', normal, compile_fail, [''])
-test('T13644', expect_broken(13644), multimod_compile_fail, ['T13644','-v0'])
+test('T13644', normal, multimod_compile_fail, ['T13644','-v0'])
 test('T13568', normal, multimod_compile_fail, ['T13568','-v0'])
 test('T13947', normal, compile_fail, [''])