Add tests for Trac 4179, 4254

testsuite/tests/ghc-regress/indexed-types/should_fail/T4179.hs

+{-# LANGUAGE TypeFamilies  #-}
+
+module T4179 where
+
+class DoC a where
+     type A2 a
+     type A3 a
+     op :: a -> A2 a -> A3 a
+
+data Con x = InCon (x (Con x))
+type FCon x = x (Con x)
+
+-- should have been changed to this, which works
+-- foldDoC :: Functor f => (f a -> a) -> A2 (FCon f) -> Con f -> a
+-- foldDoC f i (InCon t) = f (fmap (foldDoC f i) t)
+-- this original version causes GHC to hang 
+foldDoC :: Functor f => (f a -> a) -> Con f -> a 
+foldDoC f (InCon t) = f (fmap (foldDoC f) t)
+
+doCon :: (DoC (FCon x)) => Con x -> A2 (FCon x) -> A3 (FCon x) 
+doCon (InCon x) = op x
+
+-- Note that if this is commented out then there's no hang: 
+-- presumably because GHC doesn't have to perform type deduction for foldDoC.
+fCon :: (Functor x, DoC (FCon x)) => Con x -> A2 (FCon x) -> A3 (FCon x) 
+fCon = foldDoC op

testsuite/tests/ghc-regress/indexed-types/should_fail/T4179.stderr

+
+T4179.hs:26:16:
+    Could not deduce (DoC (x (A2 (FCon x) -> A3 (FCon x))))
+      from the context (Functor x, DoC (FCon x))
+      arising from a use of `op'
+    Possible fix:
+      add (DoC (x (A2 (FCon x) -> A3 (FCon x)))) to the context of
+        the type signature for `fCon'
+      or add an instance declaration for
+         (DoC (x (A2 (FCon x) -> A3 (FCon x))))
+    In the first argument of `foldDoC', namely `op'
+    In the expression: foldDoC op
+    In an equation for `fCon': fCon = foldDoC op
+
+T4179.hs:26:16:
+    Could not deduce (A2 (x (A2 (FCon x) -> A3 (FCon x)))
+                        ~
+                      A2 (FCon x))
+      from the context (Functor x, DoC (FCon x))
+    NB: `A2' is a type function, and may not be injective
+    In the first argument of `foldDoC', namely `op'
+    In the expression: foldDoC op
+    In an equation for `fCon': fCon = foldDoC op
+
+T4179.hs:26:16:
+    Could not deduce (A3 (x (A2 (FCon x) -> A3 (FCon x)))
+                        ~
+                      A3 (FCon x))
+      from the context (Functor x, DoC (FCon x))
+    NB: `A3' is a type function, and may not be injective
+    In the first argument of `foldDoC', namely `op'
+    In the expression: foldDoC op
+    In an equation for `fCon': fCon = foldDoC op

testsuite/tests/ghc-regress/indexed-types/should_fail/T4254.hs

+{-# LANGUAGE TypeFamilies, FunctionalDependencies, RankNTypes, MultiParamTypeClasses #-}
+module T4254 where
+
+class FD a b | a -> b where 
+  op :: a -> b; 
+  op = undefined 
+
+instance FD Int Bool
+
+ok1   :: forall a b. (a~Int,FD a b) => a -> b
+ok1    = op
+-- Should be OK: op has the right type
+
+ok2   :: forall a b. (a~Int,FD a b,b~Bool) => a -> Bool
+ok2    = op
+-- Should be OK: needs the b~Bool
+
+fails :: forall a b. (a~Int,FD a b) => a -> Bool 
+fails  = op
+-- Should fail: no proof that b~Bool

testsuite/tests/ghc-regress/indexed-types/should_fail/T4254.stderr

+
+T4254.hs:19:10:
+    Couldn't match type `b' with `Bool'
+      `b' is a rigid type variable bound by
+          the type signature for `fails' at T4254.hs:18:19
+    In the expression: op
+    In an equation for `fails': fails = op

testsuite/tests/ghc-regress/indexed-types/should_fail/all.T

@@ -59,4 +59,6 @@ test('T4093b', normal, compile_fail, [''])
 test('T3330a', reqlib('mtl'), compile_fail, [''])
 test('T3330b', normal, compile_fail, [''])
 test('T3330c', normal, compile_fail, [''])
+test('T4179', normal, compile_fail, [''])
+test('T4254', normal, compile_fail, [''])