1 files changed, 48 insertions, 0 deletions
diff --git a/testsuite/tests/typecheck/should_run/tcrun016.hs b/testsuite/tests/typecheck/should_run/tcrun016.hs
new file mode 100644
index 0000000000..b498ed4220
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/tcrun016.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
+             FlexibleInstances #-}
+
+-- !!! Functional dependencies
+-- This one made the 5.00.1 typechecker go into an infinite loop.
+-- The context simplifier keep thinking it was doing an 'improve'
+-- step, and hence kept going round and round.
+
+module Main where
+
+main = print (get ((AttributeLeaf (MyLabel "x") 4)::Env1) (MyLabel "x"))
+
+class Eq l => Domain d l | d -> l where
+	(<<) :: d -> d -> d
+	empty :: d
+class Domain e l => Environment e l t | e -> l t where
+	get :: e -> l -> Maybe t
+	attribute :: l -> t -> e
+
+class Eq' a where
+	(=?=) :: a -> a -> Bool
+
+newtype MyLabel = MyLabel String deriving Eq
+
+instance Eq' MyLabel where
+	l =?= l' = l == l'
+
+data BinTreeEnv l t = 
+	EmptyEnv | 
+	AttributeLeaf l t | 
+	Union (BinTreeEnv l t) (BinTreeEnv l t)
+
+instance (Eq l, Eq' l) => Domain (BinTreeEnv l t) l where
+	EmptyEnv << d = d
+	d << EmptyEnv = d
+	d << d' = Union d d'
+	empty = EmptyEnv
+
+instance (Eq l, Eq' l) => Environment (BinTreeEnv l t) l t where
+	get EmptyEnv l = Nothing
+	get (AttributeLeaf l t) l' = if l =?= l' then Just t
+				     else Nothing
+	get (Union d d') l = error "!??"
+
+        attribute l t = AttributeLeaf l t
+
+type Env1 = BinTreeEnv MyLabel Integer
+