Commit 1879d9d2 authored by Ryan Scott's avatar Ryan Scott

Check for mismatched class methods during typechecking

Summary:
Template Haskell provides a wormhole through which you can
sneak methods that don't belong to a class into an instance for that
class, bypassing the renamer's validity checks. The solution adopted
here is to mirror the treatment for associated type family instances,
which have an additional check in the typechecker which catch
mismatched associated type families that were snuck through using
Template Haskell. I've put a similar check for class methods into
`tcMethods`.

Test Plan: make test TEST=T12387

Reviewers: bgamari, simonpj

Reviewed By: bgamari, simonpj

Subscribers: simonpj, rwbarton, thomie, carter

GHC Trac Issues: #12387

Differential Revision: https://phabricator.haskell.org/D4710
parent 49691c4f
......@@ -997,7 +997,7 @@ collect_bind omitPatSyn (PatSynBind _ (PSB { psb_id = L _ ps })) acc
collect_bind _ (PatSynBind _ (XPatSynBind _)) acc = acc
collect_bind _ (XHsBindsLR _) acc = acc
collectMethodBinders :: LHsBindsLR GhcPs idR -> [Located RdrName]
collectMethodBinders :: LHsBindsLR idL idR -> [Located (IdP idL)]
-- Used exclusively for the bindings of an instance decl which are all FunBinds
collectMethodBinders binds = foldrBag (get . unLoc) [] binds
where
......
......@@ -651,8 +651,10 @@ lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = do
NameNotFound -> return (Left (unknownSubordinateErr doc rdr_name))
FoundName _p n -> return (Right n)
FoundFL fl -> return (Right (flSelector fl))
IncorrectParent {} -> return $ Left (unknownSubordinateErr doc rdr_name)
IncorrectParent {}
-- See [Mismatched class methods and associated type families]
-- in TcInstDecls.
-> return $ Left (unknownSubordinateErr doc rdr_name)
{-
Note [Family instance binders]
......
......@@ -60,6 +60,7 @@ import DynFlags
import ErrUtils
import FastString
import Id
import ListSetOps
import MkId
import Name
import NameSet
......@@ -1306,6 +1307,7 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys
-- The lexical_tvs scope over the 'where' part
do { traceTc "tcInstMeth" (ppr sigs $$ ppr binds)
; checkMinimalDefinition
; checkMethBindMembership
; (ids, binds, mb_implics) <- set_exts exts $
mapAndUnzip3M tc_item op_items
; return (ids, listToBag binds, listToBag (catMaybes mb_implics)) }
......@@ -1368,6 +1370,41 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys
methodExists meth = isJust (findMethodBind meth binds prag_fn)
----------------------
-- Check if any method bindings do not correspond to the class.
-- See Note [Mismatched class methods and associated type families].
checkMethBindMembership
= let bind_nms = map unLoc $ collectMethodBinders binds
cls_meth_nms = map (idName . fst) op_items
mismatched_meths = bind_nms `minusList` cls_meth_nms
in forM_ mismatched_meths $ \mismatched_meth ->
addErrTc $ hsep
[ text "Class", quotes (ppr (className clas))
, text "does not have a method", quotes (ppr mismatched_meth)]
{-
Note [Mismatched class methods and associated type families]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's entirely possible for someone to put methods or associated type family
instances inside of a class in which it doesn't belong. For instance, we'd
want to fail if someone wrote this:
instance Eq () where
type Rep () = Maybe
compare = undefined
Since neither the type family `Rep` nor the method `compare` belong to the
class `Eq`. Normally, this is caught in the renamer when resolving RdrNames,
since that would discover that the parent class `Eq` is incorrect.
However, there is a scenario in which the renamer could fail to catch this:
if the instance was generated through Template Haskell, as in #12387. In that
case, Template Haskell will provide fully resolved names (e.g.,
`GHC.Classes.compare`), so the renamer won't notice the sleight-of-hand going
on. For this reason, we also put an extra validity check for this in the
typechecker as a last resort.
-}
------------------------
tcMethodBody :: Class -> [TcTyVar] -> [EvVar] -> [TcType]
-> TcEvBinds -> Bool
......
......@@ -1590,6 +1590,8 @@ checkConsistentFamInst
checkConsistentFamInst Nothing _ _ _ = return ()
checkConsistentFamInst (Just (clas, inst_tvs, mini_env)) fam_tc at_tys pp_hs_pats
= do { -- Check that the associated type indeed comes from this class
-- See [Mismatched class methods and associated type families]
-- in TcInstDecls.
checkTc (Just clas == tyConAssoc_maybe fam_tc)
(badATErr (className clas) (tyConName fam_tc))
......
{-# LANGUAGE TemplateHaskell #-}
module T12387 where
import Language.Haskell.TH.Lib
data Foo = Foo
$(do d <- instanceD (cxt []) (conT ''Eq `appT` conT ''Foo)
[funD 'compare [clause [] (normalB $ varE 'undefined) []]]
return [d])
T12387.hs:8:3: error:
• Class ‘Eq’ does not have a method ‘compare’
• In the instance declaration for ‘Eq Foo’
......@@ -360,6 +360,7 @@ test('T11629', normal, compile, ['-v0'])
test('T8761', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T12130', [], multimod_compile,
['T12130', '-v0 ' + config.ghc_th_way_flags])
test('T12387', normal, compile_fail, ['-v0'])
test('T12403', omit_ways(['ghci']),
compile_and_run, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T12407', omit_ways(['ghci']), compile, ['-v0'])
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment