[commit: ghc] wip/orf-reboot: Do a global lookup when renaming fields in updates (f24192e)

[git at git.haskell.org]

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

On branch  : wip/orf-reboot
Link       : http://ghc.haskell.org/trac/ghc/changeset/f24192e3bcbe3c188e6307125fdc884e45cb50f0/ghc

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

commit f24192e3bcbe3c188e6307125fdc884e45cb50f0
Author: Adam Gundry <adam at well-typed.com>
Date:   Thu Jul 9 18:03:00 2015 +0100

    Do a global lookup when renaming fields in updates


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

f24192e3bcbe3c188e6307125fdc884e45cb50f0
 compiler/rename/RnEnv.hs                           |  2 +-
 compiler/rename/RnPat.hs                           |  2 +-
 testsuite/tests/overloadedrecflds/should_run/all.T |  1 +
 .../should_run/overloadedrecfldsrun05.hs           | 27 ++++++++++++++++++++++
 .../should_run/overloadedrecfldsrun05.stdout       |  4 ++++
 5 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 952ff01..d203a58 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -14,7 +14,7 @@ module RnEnv (
         lookupLocalOccThLvl_maybe,
         lookupTypeOccRn, lookupKindOccRn,
         lookupGlobalOccRn, lookupGlobalOccRn_maybe,
-        lookupOccRn_overloaded,
+        lookupOccRn_overloaded, lookupGlobalOccRn_overloaded,
         reportUnboundName, unknownNameSuggestions,
 
         HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index 21b0943..19fada3 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -675,7 +675,7 @@ rnHsRecUpdFields flds
                       -- Defer renaming of overloaded fields to the typechecker
                       -- See Note [Disambiguating record updates] in TcExpr
                       if overload_ok
-                          then do { mb <- lookupOccRn_overloaded overload_ok lbl
+                          then do { mb <- lookupGlobalOccRn_overloaded overload_ok lbl
                                   ; case mb of
                                       Nothing -> do { addErr (unknownSubordinateErr doc lbl)
                                                     ; return (Right []) }
diff --git a/testsuite/tests/overloadedrecflds/should_run/all.T b/testsuite/tests/overloadedrecflds/should_run/all.T
index a062b1b..012916a 100644
--- a/testsuite/tests/overloadedrecflds/should_run/all.T
+++ b/testsuite/tests/overloadedrecflds/should_run/all.T
@@ -6,3 +6,4 @@ test('overloadedrecfldsrun02',
      multimod_compile_and_run, ['overloadedrecfldsrun02', ''])
 test('overloadedrecfldsrun03', normal, compile_and_run, [''])
 test('overloadedrecfldsrun04', normal, compile_and_run, [''])
+test('overloadedrecfldsrun05', normal, compile_and_run, [''])
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.hs
new file mode 100644
index 0000000..0cb9041
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.hs
@@ -0,0 +1,27 @@
+-- Test that AllowDuplicateRecordFields works with NamedFieldPuns and
+-- RecordWildCards
+
+{-# LANGUAGE AllowDuplicateRecordFields, NamedFieldPuns, RecordWildCards #-}
+
+data S = MkS { foo :: Int }
+  deriving Show
+data T = MkT { foo :: Int }
+  deriving Show
+
+f MkS{foo} = MkT{foo}
+
+g MkT{..} = MkS{..}
+
+h e = let foo = 6 in e { foo } :: S
+
+main = do print a
+          print b
+          print c
+          print d
+  where
+    foo = 42
+
+    a = MkS{foo}
+    b = f a
+    c = g b
+    d = h c
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.stdout
new file mode 100644
index 0000000..d7796b8
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.stdout
@@ -0,0 +1,4 @@
+MkS {foo = 42}
+MkT {foo = 42}
+MkS {foo = 42}
+MkS {foo = 6}