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'