Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/a457a9d3681dd00705c1c5775afb84fd85ac554e >--------------------------------------------------------------- commit a457a9d3681dd00705c1c5775afb84fd85ac554e Author: Simon Peyton Jones <simo...@microsoft.com> Date: Wed Oct 31 09:49:48 2012 +0000 Test Trac #7264 >--------------------------------------------------------------- tests/typecheck/should_fail/T7264.hs | 13 +++++++++++++ tests/typecheck/should_fail/T7264.stderr | 17 +++++++++++++++++ tests/typecheck/should_fail/all.T | 1 + 3 files changed, 31 insertions(+), 0 deletions(-) diff --git a/tests/typecheck/should_fail/T7264.hs b/tests/typecheck/should_fail/T7264.hs new file mode 100644 index 0000000..b9d3624 --- /dev/null +++ b/tests/typecheck/should_fail/T7264.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE RankNTypes #-} +module T7264 where + +data Foo = Foo (forall r . r -> String) + +mmap :: (a->b) -> Maybe a -> Maybe b +mmap f (Just x) = Just (f x) +mmap f Nothing = Nothing + +-- mkFoo2 :: (forall r. r -> String) -> Maybe Foo +-- Should be rejected because it requires instantiating +-- mmap at a polymorphic type +mkFoo2 val = mmap Foo (Just val) diff --git a/tests/typecheck/should_fail/T7264.stderr b/tests/typecheck/should_fail/T7264.stderr new file mode 100644 index 0000000..8ed4ec2 --- /dev/null +++ b/tests/typecheck/should_fail/T7264.stderr @@ -0,0 +1,17 @@ + +T7264.hs:13:19: + Couldn't match type `a' with `forall r. r -> String' + `a' is untouchable + inside the constraints () + bound by the inferred type of mkFoo2 :: a -> Maybe Foo + at T7264.hs:13:1-32 + `a' is a rigid type variable bound by + the inferred type of mkFoo2 :: a -> Maybe Foo at T7264.hs:13:1 + Expected type: a -> Foo + Actual type: (forall r. r -> String) -> Foo + Relevant bindings include + mkFoo2 :: a -> Maybe Foo (bound at T7264.hs:13:1) + val :: a (bound at T7264.hs:13:8) + In the first argument of `mmap', namely `Foo' + In the expression: mmap Foo (Just val) + In an equation for `mkFoo2': mkFoo2 val = mmap Foo (Just val) diff --git a/tests/typecheck/should_fail/all.T b/tests/typecheck/should_fail/all.T index cbc393b..a621298 100644 --- a/tests/typecheck/should_fail/all.T +++ b/tests/typecheck/should_fail/all.T @@ -284,3 +284,4 @@ test('T7175', normal, compile_fail, ['']) test('T7210', normal, compile_fail, ['']) test('T6161', normal, compile_fail, ['']) test('T7368', normal, compile_fail, ['']) +test('T7264', normal, compile_fail, ['']) _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc