diff --git a/ghc/tests/typecheck/should_compile/tc101.hs b/ghc/tests/typecheck/should_compile/tc101.hs
new file mode 100644
index 0000000000000000000000000000000000000000..7ae95d53f5f35073420ba1ecd7bccd979f2aff59
--- /dev/null
+++ b/ghc/tests/typecheck/should_compile/tc101.hs
@@ -0,0 +1,15 @@
+-- !!! Caused ghc-4.04proto to loop!
+-- !!! (as reported by Sigbjorn)
+
+module ShouldCompile where
+
+-- This made the compiler (4.04 proto) loop (stack overflow)
+-- The bug was in TcUnify.uUnboundVar and is documented there.
+
+type A a = ()
+
+f :: (A a -> a -> ()) -> ()
+f = \ _ -> ()
+
+x :: ()
+x = f (\ x p -> p x)
diff --git a/ghc/tests/typecheck/should_compile/tc101.stderr b/ghc/tests/typecheck/should_compile/tc101.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..1f2d81be151020ad94119214718a32f79bc22664
--- /dev/null
+++ b/ghc/tests/typecheck/should_compile/tc101.stderr
@@ -0,0 +1,5 @@
+ghc: module version changed to 1; reason: no old .hi file
+__export ShouldCompile A f x;
+1 f :: __forall [a] => (A   a -> a -> PrelBase.Z0T) -> PrelBase.Z0T ;
+1 type A a = PrelBase.Z0T ;
+1 x :: PrelBase.Z0T ;