[commit: ghc] master: Don't warn about defining deprecated class methods (4bda967)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/4bda9677db3fe22615b2c6e39b54a0f491dccd87

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

commit 4bda9677db3fe22615b2c6e39b54a0f491dccd87
Author: Ian Lynagh <[email protected]>
Date:   Sun Sep 23 21:09:01 2012 +0100

    Don't warn about defining deprecated class methods
    
    We only warn when the method is used, not when it is defined as part
    of an instance.

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

 compiler/rename/RnEnv.lhs |   21 +++++++++++++--------
 compiler/rename/RnPat.lhs |    2 +-
 2 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index c3fd407..c232a89 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -290,7 +290,11 @@ lookupInstDeclBndr cls what rdr
                 -- In an instance decl you aren't allowed
                 -- to use a qualified name for the method
                 -- (Although it'd make perfect sense.)
-       ; lookupSubBndrOcc (ParentIs cls) doc rdr }
+       ; lookupSubBndrOcc False -- False => we don't give deprecated
+                                -- warnings when a deprecated class
+                                -- method is defined. We only warn
+                                -- when it's used
+                          (ParentIs cls) doc rdr }
   where
     doc = what <+> ptext (sLit "of class") <+> quotes (ppr cls)
 
@@ -337,11 +341,12 @@ lookupConstructorFields con_name
 -- unambiguous because there is only one field id 'fld' in scope.
 -- But currently it's rejected.
 
-lookupSubBndrOcc :: Parent  -- NoParent   => just look it up as usual
+lookupSubBndrOcc :: Bool
+                 -> Parent  -- NoParent   => just look it up as usual
                             -- ParentIs p => use p to disambiguate
                  -> SDoc -> RdrName
                  -> RnM Name
-lookupSubBndrOcc parent doc rdr_name
+lookupSubBndrOcc warnIfDeprec parent doc rdr_name
   | Just n <- isExact_maybe rdr_name   -- This happens in derived code
   = lookupExactOcc n
 
@@ -355,7 +360,7 @@ lookupSubBndrOcc parent doc rdr_name
                 -- NB: lookupGlobalRdrEnv, not lookupGRE_RdrName!
                 --     The latter does pickGREs, but we want to allow 'x'
                 --     even if only 'M.x' is in scope
-            [gre] -> do { addUsedRdrName gre (used_rdr_name gre)
+            [gre] -> do { addUsedRdrName warnIfDeprec gre (used_rdr_name gre)
                           -- Add a usage; this is an *occurrence* site
                         ; return (gre_name gre) }
             []    -> do { addErr (unknownSubordinateErr doc rdr_name)
@@ -690,7 +695,7 @@ lookupGreRn_help rdr_name lookup
   = do  { env <- getGlobalRdrEnv
         ; case lookup env of
             []    -> return Nothing
-            [gre] -> do { addUsedRdrName gre rdr_name
+            [gre] -> do { addUsedRdrName True gre rdr_name
                         ; return (Just gre) }
             gres  -> do { addNameClashErrRn rdr_name gres
                         ; return (Just (head gres)) } }
@@ -719,13 +724,13 @@ Note [Handling of deprecations]
      - the things exported by a module export 'module M'
 
 \begin{code}
-addUsedRdrName :: GlobalRdrElt -> RdrName -> RnM ()
+addUsedRdrName :: Bool -> GlobalRdrElt -> RdrName -> RnM ()
 -- Record usage of imported RdrNames
-addUsedRdrName gre rdr
+addUsedRdrName warnIfDeprec gre rdr
   | isLocalGRE gre = return ()  -- No call to warnIfDeprecated
                                 -- See Note [Handling of deprecations]
   | otherwise      = do { env <- getGblEnv
-                        ; warnIfDeprecated gre
+                        ; when warnIfDeprec $ warnIfDeprecated gre
                         ; updMutVar (tcg_used_rdrnames env)
                                     (\s -> Set.insert rdr s) }
 
diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index e37860a..57f75fb 100644
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -483,7 +483,7 @@ rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }
     rn_fld pun_ok parent (HsRecField { hsRecFieldId = fld
                        	      	     , hsRecFieldArg = arg
                        	      	     , hsRecPun = pun })
-      = do { fld'@(L loc fld_nm) <- wrapLocM (lookupSubBndrOcc parent doc) fld
+      = do { fld'@(L loc fld_nm) <- wrapLocM (lookupSubBndrOcc True parent doc) fld
            ; arg' <- if pun 
                      then do { checkErr pun_ok (badPun fld)
                              ; return (L loc (mk_arg (mkRdrUnqual (nameOccName fld_nm)))) }