[commit: ghc] ghc-8.0: Do not warn about unused underscore-prefixed fields (fixes Trac #12609) (63ce9ba)

[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/63ce9ba2f439f4e295ff0791d783eb2103d89843/ghc

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

commit 63ce9ba2f439f4e295ff0791d783eb2103d89843
Author: Adam Gundry <adam at well-typed.com>
Date:   Sat Oct 1 17:56:58 2016 -0400

    Do not warn about unused underscore-prefixed fields (fixes Trac #12609)
    
    When DuplicateRecordFields is enabled, the mangling of selector names
    was causing them to be reported as unused even if prefixed by an
    underscore. This corrects the OccName used by the check.
    
    Test Plan: New test overloadedrecflds/should_compile/T12609
    
    Reviewers: austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2549
    
    GHC Trac Issues: #12609
    
    (cherry picked from commit 48ff0843eee29313cc2da14c04dc57f6589ab040)


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

63ce9ba2f439f4e295ff0791d783eb2103d89843
 compiler/rename/RnEnv.hs                                   | 13 ++++++++-----
 testsuite/tests/overloadedrecflds/should_compile/T12609.hs |  8 ++++++++
 testsuite/tests/overloadedrecflds/should_compile/all.T     |  1 +
 3 files changed, 17 insertions(+), 5 deletions(-)

diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 046983a..f8f6eea 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -2112,7 +2112,7 @@ warnUnused flag names = do
 
 warnUnused1 :: WarningFlag -> NameEnv (FieldLabelString, Name) -> Name -> RnM ()
 warnUnused1 flag fld_env name
-  = when (reportable name) $
+  = when (reportable name occ) $
     addUnusedWarning flag
                      occ (nameSrcSpan name)
                      (text "Defined but not used")
@@ -2125,7 +2125,7 @@ warnUnusedGRE :: GlobalRdrElt -> RnM ()
 warnUnusedGRE gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = is })
   | lcl       = do fld_env <- mkFieldEnv <$> getGlobalRdrEnv
                    warnUnused1 Opt_WarnUnusedTopBinds fld_env name
-  | otherwise = when (reportable name) (mapM_ warn is)
+  | otherwise = when (reportable name occ) (mapM_ warn is)
   where
     occ = greOccName gre
     warn spec = addUnusedWarning Opt_WarnUnusedTopBinds occ span msg
@@ -2143,12 +2143,15 @@ mkFieldEnv rdr_env = mkNameEnv [ (gre_name gre, (lbl, par_is (gre_par gre)))
                                , Just lbl <- [greLabel gre]
                                ]
 
-reportable :: Name -> Bool
-reportable name
+-- | Should we report the fact that this 'Name' is unused? The
+-- 'OccName' may differ from 'nameOccName' due to
+-- DuplicateRecordFields.
+reportable :: Name -> OccName -> Bool
+reportable name occ
   | isWiredInName name = False    -- Don't report unused wired-in names
                                   -- Otherwise we get a zillion warnings
                                   -- from Data.Tuple
-  | otherwise = not (startsWithUnderscore (nameOccName name))
+  | otherwise = not (startsWithUnderscore occ)
 
 addUnusedWarning :: WarningFlag -> OccName -> SrcSpan -> SDoc -> RnM ()
 addUnusedWarning flag occ span msg
diff --git a/testsuite/tests/overloadedrecflds/should_compile/T12609.hs b/testsuite/tests/overloadedrecflds/should_compile/T12609.hs
new file mode 100644
index 0000000..7b8205b
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_compile/T12609.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Werror -Wunused-top-binds #-}
+module Main (main, T(MkT)) where
+
+data T = MkT { _x :: Int }
+
+main :: IO ()
+main = return ()
diff --git a/testsuite/tests/overloadedrecflds/should_compile/all.T b/testsuite/tests/overloadedrecflds/should_compile/all.T
index ea5baf8..264fa11 100644
--- a/testsuite/tests/overloadedrecflds/should_compile/all.T
+++ b/testsuite/tests/overloadedrecflds/should_compile/all.T
@@ -1 +1,2 @@
 test('T11173', extra_clean(['T11173a.hi', 'T11173a.o']), multimod_compile, ['T11173', '-v0'])
+test('T12609', normal, compile, [''])