[commit: testsuite] master: Test Trac #7729 (516107e)

[Simon Peyton Jones]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/516107ea087e281eef8efb1ee3db40fbeac5e137

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

commit 516107ea087e281eef8efb1ee3db40fbeac5e137
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Mar 1 18:04:35 2013 +0000

    Test Trac #7729

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

 tests/indexed-types/should_fail/T7729.hs      |   28 +++++++++++++++++++++++++
 tests/indexed-types/should_fail/T7729.stderr  |   17 +++++++++++++++
 tests/indexed-types/should_fail/T7729a.hs     |   28 +++++++++++++++++++++++++
 tests/indexed-types/should_fail/T7729a.stderr |    8 +++++++
 tests/indexed-types/should_fail/all.T         |    4 ++-
 5 files changed, 84 insertions(+), 1 deletions(-)

diff --git a/tests/indexed-types/should_fail/T7729.hs b/tests/indexed-types/should_fail/T7729.hs
new file mode 100644
index 0000000..c542cf0
--- /dev/null
+++ b/tests/indexed-types/should_fail/T7729.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+module T7729 where
+
+class Monad m => PrimMonad m where
+  type PrimState m
+
+class MonadTrans t where
+  lift :: Monad m => m a -> t m a
+
+class (PrimMonad (BasePrimMonad m), Monad m) => MonadPrim m where
+  type BasePrimMonad m :: * -> *
+  liftPrim :: BasePrimMonad m a -> m a
+
+
+newtype Rand m a = Rand {
+  runRand :: Maybe (m ()) -> m a
+  }
+
+instance (Monad m) => Monad (Rand m) where
+  return           = Rand . const . return
+  (Rand rnd) >>= f = Rand $ \g -> (\x -> runRand (f x) g) =<< rnd g
+
+instance MonadTrans Rand where
+  lift = Rand . const
+
+instance MonadPrim m => MonadPrim (Rand m) where
+  type BasePrimMonad (Rand m) = BasePrimMonad m
+  liftPrim = liftPrim . lift
\ No newline at end of file
diff --git a/tests/indexed-types/should_fail/T7729.stderr b/tests/indexed-types/should_fail/T7729.stderr
new file mode 100644
index 0000000..4b12b29
--- /dev/null
+++ b/tests/indexed-types/should_fail/T7729.stderr
@@ -0,0 +1,17 @@
+
+T7729.hs:28:14:
+    Could not deduce (BasePrimMonad (Rand m)
+                      ~ t0 (BasePrimMonad (Rand m)))
+    from the context (PrimMonad (BasePrimMonad (Rand m)),
+                      Monad (Rand m),
+                      MonadPrim m)
+      bound by the instance declaration at T7729.hs:26:10-42
+    The type variable ‛t0’ is ambiguous
+    Expected type: t0 (BasePrimMonad (Rand m)) a -> Rand m a
+      Actual type: BasePrimMonad (Rand m) a -> Rand m a
+    Relevant bindings include
+      liftPrim :: BasePrimMonad (Rand m) a -> Rand m a
+        (bound at T7729.hs:28:3)
+    In the first argument of ‛(.)’, namely ‛liftPrim’
+    In the expression: liftPrim . lift
+    In an equation for ‛liftPrim’: liftPrim = liftPrim . lift
diff --git a/tests/indexed-types/should_fail/T7729a.hs b/tests/indexed-types/should_fail/T7729a.hs
new file mode 100644
index 0000000..53c1639
--- /dev/null
+++ b/tests/indexed-types/should_fail/T7729a.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+module T7729a where
+
+class Monad m => PrimMonad m where
+  type PrimState m
+
+class MonadTrans t where
+  lift :: Monad m => m a -> t m a
+
+class (PrimMonad (BasePrimMonad m), Monad m) => MonadPrim m where
+  type BasePrimMonad m :: * -> *
+  liftPrim :: BasePrimMonad m a -> m a
+
+
+newtype Rand m a = Rand {
+  runRand :: Maybe (m ()) -> m a
+  }
+
+instance (Monad m) => Monad (Rand m) where
+  return           = Rand . const . return
+  (Rand rnd) >>= f = Rand $ \g -> (\x -> runRand (f x) g) =<< rnd g
+
+instance MonadTrans Rand where
+  lift = Rand . const
+
+instance MonadPrim m => MonadPrim (Rand m) where
+  type BasePrimMonad (Rand m) = BasePrimMonad m
+  liftPrim x = liftPrim (lift x)   -- This line changed from T7729
\ No newline at end of file
diff --git a/tests/indexed-types/should_fail/T7729a.stderr b/tests/indexed-types/should_fail/T7729a.stderr
new file mode 100644
index 0000000..54eeea0
--- /dev/null
+++ b/tests/indexed-types/should_fail/T7729a.stderr
@@ -0,0 +1,8 @@
+
+T7729a.hs:28:31:
+    Occurs check: cannot construct the infinite type: m0 ~ t0 m0
+    Expected type: m0 a
+      Actual type: BasePrimMonad (Rand m) a
+    In the first argument of ‛lift’, namely ‛x’
+    In the first argument of ‛liftPrim’, namely ‛(lift x)’
+    In the expression: liftPrim (lift x)
diff --git a/tests/indexed-types/should_fail/all.T b/tests/indexed-types/should_fail/all.T
index 0196f54..2b608f2 100644
--- a/tests/indexed-types/should_fail/all.T
+++ b/tests/indexed-types/should_fail/all.T
@@ -94,4 +94,6 @@ test('T7354a',
      ['$MAKE -s --no-print-directory T7354a'])
 test('T7536', normal, compile_fail, [''])
 
-test('T7560', normal, compile_fail, [''])
\ No newline at end of file
+test('T7560', normal, compile_fail, [''])
+test('T7729', normal, compile_fail, [''])
+test('T7729a', normal, compile_fail, [''])