Check that an associated type mentions at least one type variable from the class
authorSimon Peyton Jones <simonpj@microsoft.com>
Mon, 9 Jun 2014 12:28:51 +0000 (13:28 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Mon, 9 Jun 2014 12:28:51 +0000 (13:28 +0100)
Fixes Trac #9167

compiler/typecheck/TcTyClsDecls.lhs
testsuite/tests/indexed-types/should_fail/T2888.stderr [new file with mode: 0644]
testsuite/tests/indexed-types/should_fail/T9167.hs [new file with mode: 0644]
testsuite/tests/indexed-types/should_fail/T9167.stderr [new file with mode: 0644]
testsuite/tests/indexed-types/should_fail/all.T
testsuite/tests/typecheck/should_fail/tcfail116.stderr

index 94fefbb..4239530 100644 (file)
@@ -1620,7 +1620,7 @@ checkValidClass cls
                 -- since there is no possible ambiguity
         ; let grown_tyvars = growThetaTyVars theta (mkVarSet tyvars)
         ; checkTc (arity == 0 || tyVarsOfType tau `intersectsVarSet` grown_tyvars)
-                  (noClassTyVarErr cls sel_id)
+                  (noClassTyVarErr cls (ptext (sLit "class method") <+> quotes (ppr sel_id)))
 
         ; case dm of
             GenDefMeth dm_name -> do { dm_id <- tcLookupId dm_name
@@ -1643,8 +1643,12 @@ checkValidClass cls
                 -- type variable.  What a mess!
 
     check_at_defs (fam_tc, defs)
-      = tcAddDefaultAssocDeclCtxt (tyConName fam_tc) $
-        mapM_ (checkValidTyFamInst mb_clsinfo fam_tc) defs
+      = do { traceTc "check-at" (ppr fam_tc $$ ppr (tyConTyVars fam_tc) $$ ppr tyvars)
+           ; checkTc (any (`elem` tyvars) (tyConTyVars fam_tc)) 
+                     (noClassTyVarErr cls (ptext (sLit "associated type") <+> quotes (ppr fam_tc)))
+                     
+           ; tcAddDefaultAssocDeclCtxt (tyConName fam_tc) $
+             mapM_ (checkValidTyFamInst mb_clsinfo fam_tc) defs }
 
     mb_clsinfo = Just (cls, mkVarEnv [ (tv, mkTyVarTy tv) | tv <- tyvars ])
 
@@ -2067,11 +2071,11 @@ classFunDepsErr cls
   = vcat [ptext (sLit "Fundeps in class") <+> quotes (ppr cls),
           parens (ptext (sLit "Use FunctionalDependencies to allow fundeps"))]
 
-noClassTyVarErr :: Class -> Var -> SDoc
-noClassTyVarErr clas op
-  = sep [ptext (sLit "The class method") <+> quotes (ppr op),
+noClassTyVarErr :: Class -> SDoc -> SDoc
+noClassTyVarErr clas what
+  = sep [ptext (sLit "The") <+> what,
          ptext (sLit "mentions none of the type variables of the class") <+>
-                ppr clas <+> hsep (map ppr (classTyVars clas))]
+                quotes (ppr clas <+> hsep (map ppr (classTyVars clas)))]
 
 recSynErr :: [LTyClDecl Name] -> TcRn ()
 recSynErr syn_decls
diff --git a/testsuite/tests/indexed-types/should_fail/T2888.stderr b/testsuite/tests/indexed-types/should_fail/T2888.stderr
new file mode 100644 (file)
index 0000000..df217dd
--- /dev/null
@@ -0,0 +1,5 @@
+
+T2888.hs:6:1:
+    The associated type ‘D’
+    mentions none of the type variables of the class ‘C w’
+    In the class declaration for ‘C’
diff --git a/testsuite/tests/indexed-types/should_fail/T9167.hs b/testsuite/tests/indexed-types/should_fail/T9167.hs
new file mode 100644 (file)
index 0000000..2d2f555
--- /dev/null
@@ -0,0 +1,6 @@
+ {-# LANGUAGE TypeFamilies #-}
+
+module T9167 where
+
+class C a where
+   type F b
diff --git a/testsuite/tests/indexed-types/should_fail/T9167.stderr b/testsuite/tests/indexed-types/should_fail/T9167.stderr
new file mode 100644 (file)
index 0000000..ec230fa
--- /dev/null
@@ -0,0 +1,5 @@
+
+T9167.hs:5:1:
+    The associated type ‘F’
+    mentions none of the type variables of the class ‘C a’
+    In the class declaration for ‘C’
index 003b51d..d60f15f 100644 (file)
@@ -47,7 +47,7 @@ test('T2157', normal, compile_fail, [''])
 test('T2203a', normal, compile_fail, [''])
 test('T2627b', normal, compile_fail, [''])
 test('T2693', normal, compile_fail, [''])
-test('T2888', normal, compile, [''])
+test('T2888', normal, compile_fail, [''])
 test('T3092', normal, compile_fail, [''])
 test('NoMatchErr', normal, compile_fail, [''])
 test('T2677', normal, compile_fail, [''])
@@ -120,4 +120,5 @@ test('T8368', normal, compile_fail, [''])
 test('T8368a', normal, compile_fail, [''])
 test('T8518', normal, compile_fail, [''])
 test('T9036', normal, compile_fail, [''])
+test('T9167', normal, compile_fail, [''])
 
index 0fdafcf..51b89ef 100644 (file)
@@ -1,6 +1,6 @@
 
 tcfail116.hs:5:1:
     The class method ‘bug’
-    mentions none of the type variables of the class Foo a
+    mentions none of the type variables of the class ‘Foo a’
     When checking the class method: bug :: ()
     In the class declaration for ‘Foo’