diff --git a/testsuite/tests/ghc-regress/typecheck/should_fail/all.T b/testsuite/tests/ghc-regress/typecheck/should_fail/all.T index f0e91a9f3a0f67b2f8fda4a28ad4f8e6dbc8c431..f6538913a135c170118ae890a4b1a929244d817f 100644 --- a/testsuite/tests/ghc-regress/typecheck/should_fail/all.T +++ b/testsuite/tests/ghc-regress/typecheck/should_fail/all.T @@ -159,4 +159,5 @@ test('tcfail170', normal, compile_fail, ['']) test('tcfail171', normal, compile_fail, ['']) test('tcfail172', normal, compile_fail, ['']) test('tcfail173', normal, compile_fail, ['']) +test('tcfail174', normal, compile_fail, ['']) diff --git a/testsuite/tests/ghc-regress/typecheck/should_fail/tcfail174.hs b/testsuite/tests/ghc-regress/typecheck/should_fail/tcfail174.hs new file mode 100644 index 0000000000000000000000000000000000000000..55e759237033f2b881e7eb806767810d5176f9a4 --- /dev/null +++ b/testsuite/tests/ghc-regress/typecheck/should_fail/tcfail174.hs @@ -0,0 +1,17 @@ +{-# OPTIONS -fglasgow-exts #-} + +module Foo where + +data Capture a = Base a + | Capture (Capture (forall x . x -> a)) + +g :: Capture (forall a . a -> a) +g = Base id + +-- This function should definitely be rejected, with or without type signature + +h1 = Capture g + +h2 :: Capture b +h2 = Capture g + diff --git a/testsuite/tests/ghc-regress/typecheck/should_fail/tcfail174.stderr b/testsuite/tests/ghc-regress/typecheck/should_fail/tcfail174.stderr new file mode 100644 index 0000000000000000000000000000000000000000..bb6a008e5b7826ac05af2ed7ab62a96fa412c9a0 --- /dev/null +++ b/testsuite/tests/ghc-regress/typecheck/should_fail/tcfail174.stderr @@ -0,0 +1,19 @@ + +tcfail174.hs:13:13: + Inferred type is less polymorphic than expected + Quantified type variable `a' escapes + When matching `forall a. a -> a' + and `forall a. a -> a1' + Expected type: Capture (forall x. x -> a) + Inferred type: Capture (forall a2. a2 -> a2) + In the first argument of `Capture', namely `g' + +tcfail174.hs:16:13: + Couldn't match expected type `b' (a rigid variable) + against inferred type `a' (a rigid variable) + `b' is bound by the type signature for `h2' at tcfail174.hs:15:14 + When matching `forall a. a -> a' + and `forall a. a -> b' + Expected type: Capture (forall x. x -> b) + Inferred type: Capture (forall a1. a1 -> a1) + In the first argument of `Capture', namely `g'