[commit: testsuite] master: Test Trac #7354 (4bf1937)

Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/4bf1937bac0428ce7955a7fbd8c31b2128b165ab

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

commit 4bf1937bac0428ce7955a7fbd8c31b2128b165ab
Author: Simon Peyton Jones <[email protected]>
Date:   Fri Oct 26 17:28:20 2012 +0100

    Test Trac #7354

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

 tests/indexed-types/should_fail/T7354.hs     |   32 ++++++++++++++++++++++++++
 tests/indexed-types/should_fail/T7354.stderr |   11 +++++++++
 tests/indexed-types/should_fail/all.T        |    1 +
 3 files changed, 44 insertions(+), 0 deletions(-)

diff --git a/tests/indexed-types/should_fail/T7354.hs b/tests/indexed-types/should_fail/T7354.hs
new file mode 100644
index 0000000..bdf9e8f
--- /dev/null
+++ b/tests/indexed-types/should_fail/T7354.hs
@@ -0,0 +1,32 @@
+{-# 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
+
diff --git a/tests/indexed-types/should_fail/T7354.stderr b/tests/indexed-types/should_fail/T7354.stderr
new file mode 100644
index 0000000..d5c0f1c
--- /dev/null
+++ b/tests/indexed-types/should_fail/T7354.stderr
@@ -0,0 +1,11 @@
+
+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
diff --git a/tests/indexed-types/should_fail/all.T b/tests/indexed-types/should_fail/all.T
index 633f10b..3ab9c5e 100644
--- a/tests/indexed-types/should_fail/all.T
+++ b/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, [''])