[commit: testsuite] master: Test Trac #7594 (311f560)

[Simon Peyton Jones]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/311f56074ffc9007bc96e4a040e42960fae41e2f

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

commit 311f56074ffc9007bc96e4a040e42960fae41e2f
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Jan 18 17:30:25 2013 +0000

    Test Trac #7594

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

 tests/polykinds/T7594.hs     |   27 +++++++++++++++++++++++++++
 tests/polykinds/T7594.stderr |   19 +++++++++++++++++++
 tests/polykinds/all.T        |    1 +
 3 files changed, 47 insertions(+), 0 deletions(-)

diff --git a/tests/polykinds/T7594.hs b/tests/polykinds/T7594.hs
new file mode 100644
index 0000000..89e749c
--- /dev/null
+++ b/tests/polykinds/T7594.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE UndecidableInstances  #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE GADTs           #-}
+{-# LANGUAGE Rank2Types      #-}
+module T7594 where
+
+import GHC.Prim (Constraint)
+
+class    (c1 t, c2 t) => (:&:) (c1 :: * -> Constraint) (c2 :: * -> Constraint) (t :: *)
+instance (c1 t, c2 t) => (:&:) c1 c2 t
+
+data ColD c where
+  ColD :: (c a) => a -> ColD c
+
+app :: (forall a. (c a) => a -> b) -> ColD c -> b
+app f (ColD x) = f x
+
+q :: ColD (Show :&: Real)
+q = ColD (1.2 :: Double)
+
+bar = app print q
+
+
diff --git a/tests/polykinds/T7594.stderr b/tests/polykinds/T7594.stderr
new file mode 100644
index 0000000..4be0b0a
--- /dev/null
+++ b/tests/polykinds/T7594.stderr
@@ -0,0 +1,19 @@
+h0
+h1
+h2
+
+T7594.hs:25:11:
+    Couldn't match type `b' with `IO ()'
+      `b' is untouchable
+        inside the constraints ((:&:) Show Real a)
+        bound by a type expected by the context:
+                   (:&:) Show Real a => a -> b
+        at T7594.hs:25:7-17
+      `b' is a rigid type variable bound by
+          the inferred type of bar :: b at T7594.hs:25:1
+    Expected type: a -> b
+      Actual type: a -> IO ()
+    Relevant bindings include bar :: b (bound at T7594.hs:25:1)
+    In the first argument of `app', namely `print'
+    In the expression: app print q
+    In an equation for `bar': bar = app print q
diff --git a/tests/polykinds/all.T b/tests/polykinds/all.T
index 99f8424..d84048f 100644
--- a/tests/polykinds/all.T
+++ b/tests/polykinds/all.T
@@ -82,3 +82,4 @@ test('T7438', normal, run_command, ['$MAKE -s --no-print-directory T7438'])
 test('T7404', normal, compile_fail,[''])
 test('T7502', normal, compile,[''])
 test('T7488', normal, compile,[''])
+test('T7594', normal, compile_fail,[''])