[commit: ghc] master: Test Trac #9834 (cb9bcec)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/cb9bcecceae5e6df758d0973ed0e496a07d15026/ghc

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

commit cb9bcecceae5e6df758d0973ed0e496a07d15026
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Nov 26 13:22:05 2014 +0000

    Test Trac #9834


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

cb9bcecceae5e6df758d0973ed0e496a07d15026
 testsuite/tests/typecheck/should_compile/T9834.hs  | 23 +++++++
 .../tests/typecheck/should_compile/T9834.stderr    | 71 ++++++++++++++++++++++
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 3 files changed, 95 insertions(+)

diff --git a/testsuite/tests/typecheck/should_compile/T9834.hs b/testsuite/tests/typecheck/should_compile/T9834.hs
new file mode 100644
index 0000000..c16e395
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T9834.hs
@@ -0,0 +1,23 @@
+{-# OPTIONS_GHC -fdefer-type-errors #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+
+module T9834 where
+import Control.Applicative
+import Data.Functor.Identity
+
+type Nat f g = forall a. f a -> g a
+
+newtype Comp p q a = Comp (p (q a))
+
+liftOuter :: (Functor p, Applicative q) => p a -> (Comp p q) a
+liftOuter pa = Comp (pure <$> pa)
+
+runIdComp :: Functor p => Comp p Identity a -> p a
+runIdComp (Comp p) = runIdentity <$> p
+
+wrapIdComp :: Applicative p => (forall q. Applicative q => Nat (Comp p q) (Comp p q)) -> p a -> p a
+wrapIdComp f = runIdComp . f . liftOuter
+
+class Applicative p => ApplicativeFix p where
+  afix :: (forall q. Applicative q => (Comp p q) a -> (Comp p q) a) -> p a
+  afix = wrapIdComp
\ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_compile/T9834.stderr b/testsuite/tests/typecheck/should_compile/T9834.stderr
new file mode 100644
index 0000000..e4372e5
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T9834.stderr
@@ -0,0 +1,71 @@
+
+T9834.hs:23:10: Warning:
+    Couldn't match type ‘p’ with ‘(->) (p a0)’
+      ‘p’ is a rigid type variable bound by
+          the class declaration for ‘ApplicativeFix’ at T9834.hs:21:39
+    Expected type: (forall (q :: * -> *).
+                    Applicative q =>
+                    Comp p q a -> Comp p q a)
+                   -> p a
+      Actual type: (forall (q :: * -> *).
+                    Applicative q =>
+                    Nat (Comp p q) (Comp p q))
+                   -> p a0 -> p a0
+    Relevant bindings include
+      afix :: (forall (q :: * -> *).
+               Applicative q =>
+               Comp p q a -> Comp p q a)
+              -> p a
+        (bound at T9834.hs:23:3)
+    In the expression: wrapIdComp
+    In an equation for ‘afix’: afix = wrapIdComp
+
+T9834.hs:23:10: Warning:
+    Couldn't match type ‘a’ with ‘p a0’
+      ‘a’ is a rigid type variable bound by
+          the type signature for
+            afix :: (forall (q :: * -> *).
+                     Applicative q =>
+                     Comp p q a -> Comp p q a)
+                    -> p a
+          at T9834.hs:22:11
+    Expected type: (forall (q :: * -> *).
+                    Applicative q =>
+                    Comp p q a -> Comp p q a)
+                   -> p a
+      Actual type: (forall (q :: * -> *).
+                    Applicative q =>
+                    Nat (Comp p q) (Comp p q))
+                   -> p a0 -> p a0
+    Relevant bindings include
+      afix :: (forall (q :: * -> *).
+               Applicative q =>
+               Comp p q a -> Comp p q a)
+              -> p a
+        (bound at T9834.hs:23:3)
+    In the expression: wrapIdComp
+    In an equation for ‘afix’: afix = wrapIdComp
+
+T9834.hs:23:10: Warning:
+    Couldn't match type ‘a’ with ‘a1’
+      ‘a’ is a rigid type variable bound by
+          the type signature for
+            afix :: (forall (q :: * -> *).
+                     Applicative q =>
+                     Comp p q a -> Comp p q a)
+                    -> p a
+          at T9834.hs:22:11
+      ‘a1’ is a rigid type variable bound by
+           a type expected by the context:
+             Applicative q => Comp p q a1 -> Comp p q a1
+           at T9834.hs:23:10
+    Expected type: Comp p q a1 -> Comp p q a1
+      Actual type: Comp p q a -> Comp p q a
+    Relevant bindings include
+      afix :: (forall (q :: * -> *).
+               Applicative q =>
+               Comp p q a -> Comp p q a)
+              -> p a
+        (bound at T9834.hs:23:3)
+    In the expression: wrapIdComp
+    In an equation for ‘afix’: afix = wrapIdComp
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 291d118..e1f4c3f 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -432,3 +432,4 @@ test('T9497a', normal, compile, ['-fdefer-typed-holes'])
 test('T9497b', normal, compile, ['-fdefer-typed-holes -fno-warn-typed-holes'])
 test('T9497c', normal, compile, ['-fdefer-type-errors -fno-warn-typed-holes'])
 test('T7643', normal, compile, [''])
+test('T9834', normal, compile, [''])