Test Trac #7354

testsuite/tests/indexed-types/should_fail/T7354.hs

+{-# LANGUAGE CPP, TypeFamilies, Rank2Types, FlexibleContexts, FlexibleInstances, GADTs, StandaloneDeriving, UndecidableInstances #-}
+
+module T7354 where
+
+type family Base t :: * -> *
+data family Prim t :: * -> *
+
+class Functor (Base t) => Unfoldable t where
+  embed :: Base t t -> t
+  ana
+    :: (a -> Base t a) -- ^ a (Base t)-coalgebra
+    -> a               -- ^ seed
+    -> t               -- ^ resulting fixed point
+  ana g = a where a = embed . fmap a . g
+
+
+data instance Prim [a] b = Cons a b | Nil deriving (Eq,Ord,Show,Read)
+
+coalg 0 = Nil
+coalg n = Cons n (n-1)
+alg Nil = 1
+alg (Cons a b) = a * b
+
+instance Functor (Prim [a]) where
+  fmap f (Cons a b) = Cons a (f b)
+  fmap _ Nil = Nil
+
+foo = ana alg
+
+bar = foo  -- With 7.6, the definition of foo is simply discarded by
+           -- by the type checker, which makes Lint complain about bar
+

testsuite/tests/indexed-types/should_fail/T7354.stderr

+
+T7354.hs:28:11:
+    Occurs check: cannot construct the infinite type:
+      a ~ Base t (Prim [a] a)
+    Expected type: Prim [a] a -> Base t (Prim [a] a)
+      Actual type: Prim [a] a -> a
+    Relevant bindings include
+      foo :: Prim [a] a -> t (bound at T7354.hs:28:1)
+    In the first argument of `ana', namely `alg'
+    In the expression: ana alg
+    In an equation for `foo': foo = ana alg

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

@@ -78,3 +78,4 @@ test('T6123', normal, compile_fail, [''])
 test('ExtraTcsUntch', normal, compile_fail, [''])
 test('T7010', normal, compile_fail, [''])
 test('T7194', normal, compile_fail, [''])
+test('T7354', normal, compile_fail, [''])