From 9e015feedab20c99b01bf740cb26c478ccf8f223 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Fri, 16 Jul 1999 13:34:20 +0000
Subject: [PATCH] [project @ 1999-07-16 13:34:20 by simonpj] Add tc101

---
 ghc/tests/typecheck/should_compile/tc101.hs     | 15 +++++++++++++++
 ghc/tests/typecheck/should_compile/tc101.stderr |  5 +++++
 2 files changed, 20 insertions(+)
 create mode 100644 ghc/tests/typecheck/should_compile/tc101.hs
 create mode 100644 ghc/tests/typecheck/should_compile/tc101.stderr

diff --git a/ghc/tests/typecheck/should_compile/tc101.hs b/ghc/tests/typecheck/should_compile/tc101.hs
new file mode 100644
index 000000000000..7ae95d53f5f3
--- /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 000000000000..1f2d81be1510
--- /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 ;
-- 
GitLab