Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : ghc-7.2
http://hackage.haskell.org/trac/ghc/changeset/8ec2bfe04c3efe7a1e0fdf301c63eb8280875d99 >--------------------------------------------------------------- commit 8ec2bfe04c3efe7a1e0fdf301c63eb8280875d99 Author: Simon Peyton Jones <[email protected]> Date: Fri Jul 15 18:03:55 2011 +0100 Test Trac #5300 >--------------------------------------------------------------- tests/ghc-regress/typecheck/should_fail/T5300.hs | 15 +++++++++++++++ .../ghc-regress/typecheck/should_fail/T5300.stderr | 8 ++++++++ tests/ghc-regress/typecheck/should_fail/all.T | 1 + 3 files changed, 24 insertions(+), 0 deletions(-) diff --git a/tests/ghc-regress/typecheck/should_fail/T5300.hs b/tests/ghc-regress/typecheck/should_fail/T5300.hs new file mode 100644 index 0000000..d052d84 --- /dev/null +++ b/tests/ghc-regress/typecheck/should_fail/T5300.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-} +module T5300 where + +import Control.Monad.State (StateT) + +class C1 a b c | a -> b +class C2 a b c + +data T b = T + +f1 :: (Monad m, C1 a b c) => a -> StateT (T b) m a +f1 f = undefined + +f2 :: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) => a1 -> StateT (T b2) m a2 +f2 fm = f1 fm >>= return . undefined diff --git a/tests/ghc-regress/typecheck/should_fail/T5300.stderr b/tests/ghc-regress/typecheck/should_fail/T5300.stderr new file mode 100644 index 0000000..bc3bc06 --- /dev/null +++ b/tests/ghc-regress/typecheck/should_fail/T5300.stderr @@ -0,0 +1,8 @@ + +T5300.hs:15:9: + Ambiguous type variable `c0' in the constraint: + (C1 a1 b2 c0) arising from a use of `f1' + Probable fix: add a type signature that fixes these type variable(s) + In the first argument of `(>>=)', namely `f1 fm' + In the expression: f1 fm >>= return . undefined + In an equation for `f2': f2 fm = f1 fm >>= return . undefined diff --git a/tests/ghc-regress/typecheck/should_fail/all.T b/tests/ghc-regress/typecheck/should_fail/all.T index 4d51592..5ea05ef 100644 --- a/tests/ghc-regress/typecheck/should_fail/all.T +++ b/tests/ghc-regress/typecheck/should_fail/all.T @@ -242,3 +242,4 @@ test('FailDueToGivenOverlapping', normal, compile_fail, ['']) test('LongWayOverlapping', normal, compile_fail, ['']) test('T5236',normal,compile_fail,['']) test('T5246',normal,compile_fail,['']) +test('T5300',normal,compile_fail,['']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
