Test Trac #8603
authorSimon Peyton Jones <simonpj@microsoft.com>
Sat, 28 Dec 2013 12:45:35 +0000 (12:45 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Sat, 28 Dec 2013 12:45:35 +0000 (12:45 +0000)
testsuite/tests/typecheck/should_fail/T8603.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T8603.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/all.T

diff --git a/testsuite/tests/typecheck/should_fail/T8603.hs b/testsuite/tests/typecheck/should_fail/T8603.hs
new file mode 100644 (file)
index 0000000..90c1db3
--- /dev/null
@@ -0,0 +1,32 @@
+module T8603 where
+
+import Control.Monad
+import Data.Functor
+import Control.Monad.Trans.Class( lift )
+import Control.Monad.Trans.State( StateT )
+
+newtype RV a = RV { getPDF :: [(Rational,a)] } deriving (Show, Eq)
+
+instance Functor RV where
+  fmap f = RV . map (\(x,y) -> (x, f y)) . getPDF
+
+instance Monad RV where
+  return x = RV [(1,x)]
+  rv >>= f = RV $
+    do (p,a) <- getPDF rv
+       guard (p > 0)
+       (q,b) <- getPDF $ f a
+       guard (q > 0)
+       return (p*q, b)
+
+type RVState s a = StateT s RV a
+
+uniform :: [a] -> RV a
+uniform x = RV [(1/fromIntegral (length x), y) | y <- x]
+
+testRVState1 :: RVState s Bool
+testRVState1
+  = do prize <- lift uniform [1,2,3]
+       return False
+
+-- lift :: (MonadTrans t, Monad m) => m a -> t m a
\ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_fail/T8603.stderr b/testsuite/tests/typecheck/should_fail/T8603.stderr
new file mode 100644 (file)
index 0000000..1777dc9
--- /dev/null
@@ -0,0 +1,22 @@
+\r
+T8603.hs:29:17:\r
+    Couldn't match type ‛(->) [a0]’ with ‛[t1]’\r
+    Expected type: [t1] -> StateT s RV t0\r
+      Actual type: t2 ((->) [a0]) (StateT s RV t0)\r
+    The function ‛lift’ is applied to two arguments,\r
+    but its type ‛([a0] -> StateT s RV t0)\r
+                  -> t2 ((->) [a0]) (StateT s RV t0)’\r
+    has only one\r
+    In a stmt of a 'do' block: prize <- lift uniform [1, 2, 3]\r
+    In the expression:\r
+      do { prize <- lift uniform [1, 2, ....];\r
+           return False }\r
+\r
+T8603.hs:29:22:\r
+    Couldn't match type ‛StateT s RV t0’ with ‛RV a0’\r
+    Expected type: [a0] -> StateT s RV t0\r
+      Actual type: [a0] -> RV a0\r
+    Relevant bindings include\r
+      testRVState1 :: RVState s Bool (bound at T8603.hs:28:1)\r
+    In the first argument of ‛lift’, namely ‛uniform’\r
+    In a stmt of a 'do' block: prize <- lift uniform [1, 2, 3]\r
index 93eb007..faef063 100644 (file)
@@ -329,3 +329,4 @@ test('ContextStack1', normal, compile_fail, ['-fcontext-stack=10'])
 test('ContextStack2', normal, compile_fail, ['-ftype-function-depth=10'])
 test('T8570', extra_clean(['T85570a.o', 'T8570a.hi','T85570b.o', 'T8570b.hi']),
      multimod_compile_fail, ['T8570', '-v0'])
+test('T8603', normal, compile_fail, [''])