Add tests for T3330

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

+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- A very bogus program (multiple errors) but
+-- sent GHC 6.12 into a loop
+
+module T3330a where
+
+import Control.Monad.Writer
+
+data AnyF (s :: * -> *) = AnyF
+class HFunctor (f :: (* -> *) -> * -> *)
+type family PF (phi :: * -> *) :: (* -> *) -> * -> *
+
+children :: s ix -> (PF s) r ix -> [AnyF s]
+children p x = execWriter (hmapM p collect x)
+
+collect :: HFunctor (PF s) => s ix -> r ix -> Writer [AnyF s] (r ix)
+collect = undefined
+
+hmapM :: (forall ix. phi ix -> r ix -> m (r' ix))
+      -> phi ix -> f r ix -> m (f r' ix)
+hmapM = undefined
+

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

+
+T3330a.hs:17:28:
+    Couldn't match type `ix' with `ix2'
+      because this skolem type variable would escape: `ix2'
+    This skolem is bound by
+      the polymorphic type `forall ix. phi ix -> r ix -> m (r' ix)'
+    In the first argument of `hmapM', namely `p'
+    In the first argument of `execWriter', namely `(hmapM p collect x)'
+    In the expression: execWriter (hmapM p collect x)
+
+T3330a.hs:17:34:
+    Couldn't match type `s' with `(->) (s1 ix1 -> ix)'
+      `s' is a rigid type variable bound by
+          the type signature for `children' at T3330a.hs:16:13
+    Expected type: (s1 ix1 -> ix) -> r ix -> Writer [AnyF s] (r' ix)
+      Actual type: s ix2
+    In the first argument of `hmapM', namely `p'
+    In the first argument of `execWriter', namely `(hmapM p collect x)'
+
+T3330a.hs:17:36:
+    No instance for (HFunctor (PF s))
+      arising from a use of `collect'
+    Possible fix: add an instance declaration for (HFunctor (PF s))
+    In the second argument of `hmapM', namely `collect'
+    In the first argument of `execWriter', namely `(hmapM p collect x)'
+    In the expression: execWriter (hmapM p collect x)
+
+T3330a.hs:17:44:
+    Couldn't match type `ix1' with `r ix -> Writer [AnyF s1] (r ix)'
+      `ix1' is a rigid type variable bound by
+            the type signature for `children' at T3330a.hs:16:15
+    In the third argument of `hmapM', namely `x'
+    In the first argument of `execWriter', namely `(hmapM p collect x)'
+    In the expression: execWriter (hmapM p collect x)

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

+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+-- Bizarrely this made 6.10 loop
+
+module T3330b where
+
+class RFunctor c a b where
+    type Res c a b :: *
+    rmap :: (a -> b) -> c -> Res c a b
+
+instance (a ~ c) => RFunctor c a b where
+    type Res c a b = b
+    rmap f = f
+
+instance (RFunctor c a b, a ~ c) => RFunctor [c] a b where
+    type Res [c] a b = [b]
+    rmap f = map (map f)

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

+
+T3330b.hs:14:10:
+    Conflicting family instance declarations:
+      type Res c a b -- Defined at T3330b.hs:14:10-12
+      type Res [c] a b -- Defined at T3330b.hs:18:10-12

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

+{-# LANGUAGE EmptyDataDecls, TypeFamilies, TypeOperators, GADTs, KindSignatures #-}
+
+module T3330c where
+
+data (f :+: g) x = Inl (f x) | Inr (g x)
+
+data R :: (* -> *) -> * where
+  RSum  :: R f -> R g -> R (f :+: g)
+
+class Rep f where
+  rep :: R f
+
+instance (Rep f, Rep g) => Rep (f :+: g) where
+  rep = RSum rep rep
+
+type family Der (f :: * -> *) :: * -> *
+type instance Der (f :+: g) = Der f :+: Der g
+
+plug :: Rep f => Der f x -> x -> f x
+plug = plug' rep where
+  plug' :: R f -> Der f x -> x -> f x
+  plug' (RSum rf rg) (Inl df) x = Inl (plug rf df x)

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

+
+T3330c.hs:22:35:
+    Couldn't match type `f3' with `Der f3'
+      `f3' is a rigid type variable bound by
+           a pattern with constructor
+           RSum :: forall (f :: * -> *) (g :: * -> *).
+                   R f -> R g -> R (f :+: g)
+             at T3330c.hs:22:10
+    In the expression: Inl (plug rf df x)
+    In an equation for `plug'':
+        plug' (RSum rf rg) (Inl df) x = Inl (plug rf df x)
+    In an equation for `plug':
+        plug
+          = plug' rep
+          where
+              plug' :: R f -> Der f x -> x -> f x
+              plug' (RSum rf rg) (Inl df) x = Inl (plug rf df x)
+
+T3330c.hs:22:40:
+    Could not deduce (Rep ((->) x1))
+      from the context (Rep f1, f2 ~ (f3 :+: g))
+      arising from a use of `plug'
+    Possible fix:
+      add (Rep ((->) x1)) to the context of
+        the data constructor `RSum'
+        or the type signature for `plug''
+        or the type signature for `plug'
+      or add an instance declaration for (Rep ((->) x1))
+    In the first argument of `Inl', namely `(plug rf df x)'
+    In the expression: Inl (plug rf df x)
+    In an equation for `plug'':
+        plug' (RSum rf rg) (Inl df) x = Inl (plug rf df x)
+
+T3330c.hs:22:45:
+    Couldn't match type `Der ((->) x)' with `R'
+    Expected type: Der ((->) x) (f x)
+      Actual type: R f1
+    In the first argument of `plug', namely `rf'
+    In the first argument of `Inl', namely `(plug rf df x)'
+
+T3330c.hs:22:45:
+    Couldn't match type `f' with `f1 x'
+      `f' is a rigid type variable bound by
+          a pattern with constructor
+          RSum :: forall (f :: * -> *) (g :: * -> *).
+                  R f -> R g -> R (f :+: g)
+            at T3330c.hs:22:10
+    Expected type: Der ((->) x) (f1 x)
+      Actual type: R f
+    In the first argument of `plug', namely `rf'
+    In the first argument of `Inl', namely `(plug rf df x)'

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

@@ -56,3 +56,7 @@ test('T4272', normal, compile_fail, [''])
 test('T4246', normal, compile_fail, [''])
 test('T4093a', normal, compile_fail, [''])
 test('T4093b', normal, compile_fail, [''])
+test('T3330a', normal, compile_fail, [''])
+test('T3330b', normal, compile_fail, [''])
+test('T3330c', normal, compile_fail, [''])
+