[commit: ghc] master: Make AutoDeriveTypeable work for associated datatypes (fix #9999) (d839493)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d839493991e508160d416311ba47b7a7e2d62aae/ghc

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

commit d839493991e508160d416311ba47b7a7e2d62aae
Author: Jose Pedro Magalhaes <dreixel at gmail.com>
Date:   Mon Jan 19 13:36:03 2015 +0000

    Make AutoDeriveTypeable work for associated datatypes (fix #9999)


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

d839493991e508160d416311ba47b7a7e2d62aae
 compiler/typecheck/TcDeriv.hs                     | 13 +++++++++----
 testsuite/tests/typecheck/should_compile/T9999.hs | 13 +++++++++++++
 testsuite/tests/typecheck/should_compile/all.T    |  1 +
 3 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index 10191ae..ae95f33 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -561,11 +561,16 @@ deriveAutoTypeable auto_typeable done_specs tycl_decls
 
     do_one cls (L _ decl)
       = do { tc <- tcLookupTyCon (tcdName decl)
-           ; if (isTypeSynonymTyCon tc || isTypeFamilyTyCon tc
+           -- Traverse into class declarations to check if they have ATs (#9999)
+           ; ats <- if isClassDecl decl
+                    then concatMapM (do_one cls) (map (fmap FamDecl) (tcdATs decl))
+                    else return []
+           ; rest <- if (isTypeSynonymTyCon tc || isTypeFamilyTyCon tc
                                        || tyConName tc `elemNameSet` done_tcs)
-                 -- Do not derive Typeable for type synonyms or type families
-             then return []
-             else mkPolyKindedTypeableEqn cls tc }
+                     -- Do not derive Typeable for type synonyms or type families
+                     then return []
+                     else mkPolyKindedTypeableEqn cls tc
+          ; return (ats ++ rest) }
 
 ------------------------------------------------------------------
 deriveTyDecl :: LTyClDecl Name -> TcM [EarlyDerivSpec]
diff --git a/testsuite/tests/typecheck/should_compile/T9999.hs b/testsuite/tests/typecheck/should_compile/T9999.hs
new file mode 100644
index 0000000..656e913
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T9999.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE AutoDeriveTypeable, PolyKinds, TypeFamilies, StandaloneDeriving #-}
+
+module T9999 where
+
+import Data.Typeable
+
+data family F a
+
+class C a where
+  data F1 a
+  type F2 a
+
+main = typeRep (Proxy :: Proxy F) == typeRep (Proxy :: Proxy F1)
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 38c41f1..c292eaf 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -440,3 +440,4 @@ test('T9892', normal, compile, [''])
 test('T9939', normal, compile, [''])
 test('T9973', normal, compile, [''])
 test('T9971', normal, compile, [''])
+test('T9999', normal, compile, [''])