[commit: ghc] ghc-8.0: Fix Template Haskell bug reported in #11809. (e465093)

[git at git.haskell.org]

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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/e4650932ce18e04a24aba2c8de71fe19d691f5fe/ghc

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

commit e4650932ce18e04a24aba2c8de71fe19d691f5fe
Author: Dominik Bollmann <bollmann at seas.upenn.edu>
Date:   Sun Apr 10 18:57:38 2016 +0200

    Fix Template Haskell bug reported in #11809.
    
    Record selectors of data types spliced in with Template Haskell are not
    renamer-resolved correctly in GHC HEAD. The culprit is
    `newRecordSelector` which violates notes `Note [Binders in Template
    Haskell] in Convert.hs` and `Note [Looking up Exact RdrNames] in
    RnEnv.hs`. This commit fixes `newRecordSelector` accordingly.
    
    Test Plan: ./validate
    
    Reviewers: thomie, mpickering, bgamari, austin, simonpj, goldfire
    
    Reviewed By: goldfire
    
    Differential Revision: https://phabricator.haskell.org/D2091
    
    GHC Trac Issues: #11809
    
    (cherry picked from commit 2f82da761defba2cfdc55ca08d774ca7e1240463)


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

e4650932ce18e04a24aba2c8de71fe19d691f5fe
 compiler/rename/RnNames.hs   | 19 +++++++++++++------
 testsuite/tests/th/T11809.hs | 13 +++++++++++++
 testsuite/tests/th/all.T     |  2 +-
 3 files changed, 27 insertions(+), 7 deletions(-)

diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 1659191..0bc6386 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -685,13 +685,20 @@ getLocalNonValBinders fixity_env
 
 newRecordSelector :: Bool -> [Name] -> LFieldOcc RdrName -> RnM FieldLabel
 newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!"
-newRecordSelector overload_ok (dc:_) (L loc (FieldOcc (L _ fld) _)) =
-  do { sel_name <- newTopSrcBinder $ L loc $ mkRdrUnqual sel_occ
-     ; return $ fl { flSelector = sel_name } }
+newRecordSelector overload_ok (dc:_) (L loc (FieldOcc (L _ fld) _))
+  = do { selName <- newTopSrcBinder $ L loc $ field
+       ; return $ qualFieldLbl { flSelector = selName } }
   where
-    lbl     = occNameFS $ rdrNameOcc fld
-    fl      = mkFieldLabelOccs lbl (nameOccName dc) overload_ok
-    sel_occ = flSelector fl
+    fieldOccName = occNameFS $ rdrNameOcc fld
+    qualFieldLbl = mkFieldLabelOccs fieldOccName (nameOccName dc) overload_ok
+    field | isExact fld = fld
+              -- use an Exact RdrName as is to preserve the bindings
+              -- of an already renamer-resolved field and its use
+              -- sites. This is needed to correctly support record
+              -- selectors in Template Haskell. See Note [Binders in
+              -- Template Haskell] in Convert.hs and Note [Looking up
+              -- Exact RdrNames] in RnEnv.hs.
+          | otherwise   = mkRdrUnqual (flSelector qualFieldLbl)
 
 {-
 Note [Looking up family names in family instances]
diff --git a/testsuite/tests/th/T11809.hs b/testsuite/tests/th/T11809.hs
new file mode 100644
index 0000000..bbb65fa
--- /dev/null
+++ b/testsuite/tests/th/T11809.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T11809 where
+
+{- Test splicing in a data type with records -}
+
+[d|
+ data D a = MkD { unD :: a }
+
+ someD = MkD "Hello"
+ getD  = unD someD   -- unD should resolve to the record selector above!
+ |]
+
+getD' = unD someD    -- dito here outside of the splice!
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index d5124fe..fb0c9f8 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -395,8 +395,8 @@ test('T10819',
 test('T10820', normal, compile_and_run, ['-v0'])
 test('T11341', normal, compile, ['-v0 -dsuppress-uniques'])
 test('T11345', normal, compile_and_run, ['-v0 -dsuppress-uniques'])
-
 test('TH_finalizer', normal, compile, ['-v0'])
 test('T10603', normal, compile, ['-ddump-splices -dsuppress-uniques'])
 test('T11452', normal, compile_fail, ['-v0'])
 test('T11145', normal, compile_fail, ['-v0 -dsuppress-uniques'])
+test('T11809', normal, compile, ['-v0'])