14 files changed, 147 insertions, 0 deletions
diff --git a/testsuite/tests/mdo/should_compile/Makefile b/testsuite/tests/mdo/should_compile/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/mdo/should_compile/all.T b/testsuite/tests/mdo/should_compile/all.T
new file mode 100644
index 0000000000..49be01fc59
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/all.T
@@ -0,0 +1,8 @@
+setTestOpts(only_ways(['normal']));
+
+test('mdo001', normal, compile_and_run, [''])
+test('mdo002', normal, compile_and_run, [''])
+test('mdo003', normal, compile_and_run, [''])
+test('mdo004', only_compiler_types(['ghc']), compile_and_run, [''])
+test('mdo005', normal, compile_and_run, [''])
+test('mdo006', normal, compile, [''])
diff --git a/testsuite/tests/mdo/should_compile/mdo001.hs b/testsuite/tests/mdo/should_compile/mdo001.hs
new file mode 100644
index 0000000000..e193743553
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/mdo001.hs
@@ -0,0 +1,36 @@
+{-# OPTIONS -XRecursiveDo #-}
+
+-- test that we have all the promised instances
+
+module Main(main) where
+ 
+import Control.Monad.Fix 
+import qualified Control.Monad.ST      as SST
+import qualified Control.Monad.ST.Lazy as LST
+
+generic :: MonadFix m => m [Int]
+generic = mdo xs <- return (1:xs)
+	      return (take 4 xs)
+
+io :: IO [Int]
+io = generic
+
+sst :: SST.ST s [Int]
+sst = generic
+
+lst :: LST.ST s [Int]
+lst = generic
+	
+mb :: Maybe [Int]
+mb = generic
+
+ls :: [[Int]]
+ls = generic
+
+main :: IO ()
+main = do 
+	print	=<< io
+	print	$   SST.runST sst	
+	print	$   LST.runST lst
+	print	$   mb	
+	print	$   ls
diff --git a/testsuite/tests/mdo/should_compile/mdo001.stdout b/testsuite/tests/mdo/should_compile/mdo001.stdout
new file mode 100644
index 0000000000..cfaadf8fad
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/mdo001.stdout
@@ -0,0 +1,5 @@
+[1,1,1,1]
+[1,1,1,1]
+[1,1,1,1]
+Just [1,1,1,1]
+[[1,1,1,1]]
diff --git a/testsuite/tests/mdo/should_compile/mdo002.hs b/testsuite/tests/mdo/should_compile/mdo002.hs
new file mode 100644
index 0000000000..dc33595590
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/mdo002.hs
@@ -0,0 +1,23 @@
+{-# OPTIONS -XRecursiveDo #-}
+
+-- test of user defined instance of MonadFix
+
+module Main (main) where
+
+import Control.Monad.Fix
+
+data X a = X a deriving Show
+
+instance Monad X where
+  return      = X
+  (X a) >>= f = f a
+
+instance MonadFix X where
+  mfix f = fix (f . unX) 
+         where unX ~(X x) = x
+
+z :: X [Int]
+z = mdo x <- return (1:x)
+	return (take 4 x)
+
+main = print z
diff --git a/testsuite/tests/mdo/should_compile/mdo002.stdout b/testsuite/tests/mdo/should_compile/mdo002.stdout
new file mode 100644
index 0000000000..f3b1299b8c
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/mdo002.stdout
@@ -0,0 +1 @@
+X [1,1,1,1]
diff --git a/testsuite/tests/mdo/should_compile/mdo003.hs b/testsuite/tests/mdo/should_compile/mdo003.hs
new file mode 100644
index 0000000000..1a0cb37c2e
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/mdo003.hs
@@ -0,0 +1,16 @@
+{-# OPTIONS -XRecursiveDo #-}
+
+-- test let bindings
+
+module Main (main) where
+
+import Control.Monad.Fix 
+
+t :: IO Int
+t = mdo x <- return (l "1")
+        let l [] = 0
+            l (x:xs) = 1 + l xs
+        return x
+
+main :: IO ()
+main = t >>= print
diff --git a/testsuite/tests/mdo/should_compile/mdo003.stdout b/testsuite/tests/mdo/should_compile/mdo003.stdout
new file mode 100644
index 0000000000..d00491fd7e
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/mdo003.stdout
@@ -0,0 +1 @@
+1
diff --git a/testsuite/tests/mdo/should_compile/mdo004.hs b/testsuite/tests/mdo/should_compile/mdo004.hs
new file mode 100644
index 0000000000..544ee6cc66
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/mdo004.hs
@@ -0,0 +1,17 @@
+{-# OPTIONS -XRecursiveDo #-}
+
+-- test let bindings, polymorphism is ok provided they are not 
+-- isolated in a recursive segment
+-- NB. this is not what Hugs does!
+
+module Main (main) where
+
+import Control.Monad.Fix 
+
+t :: IO (Int, Int)
+t = mdo let l [] = 0
+            l (x:xs) = 1 + l xs
+	return (l "1", l [1,2,3])
+
+main :: IO ()
+main = t >>= print
diff --git a/testsuite/tests/mdo/should_compile/mdo004.stdout b/testsuite/tests/mdo/should_compile/mdo004.stdout
new file mode 100644
index 0000000000..99a45a1c91
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/mdo004.stdout
@@ -0,0 +1 @@
+(1,3)
diff --git a/testsuite/tests/mdo/should_compile/mdo005.hs b/testsuite/tests/mdo/should_compile/mdo005.hs
new file mode 100644
index 0000000000..0b6301b8a5
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/mdo005.hs
@@ -0,0 +1,15 @@
+{-# OPTIONS -XRecursiveDo #-}
+
+-- test scoping
+
+module Main (main) where
+
+import Control.Monad.Fix 
+import Data.Maybe ( fromJust )
+
+t = mdo x <- fromJust (mdo x <- Just (1:x)
+			   return (take 4 x))
+	return x
+
+main :: IO ()
+main = print t 
diff --git a/testsuite/tests/mdo/should_compile/mdo005.stdout b/testsuite/tests/mdo/should_compile/mdo005.stdout
new file mode 100644
index 0000000000..ee67c15ef8
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/mdo005.stdout
@@ -0,0 +1 @@
+[1,1,1,1]
diff --git a/testsuite/tests/mdo/should_compile/mdo006.hs b/testsuite/tests/mdo/should_compile/mdo006.hs
new file mode 100644
index 0000000000..6ccfb94041
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/mdo006.hs
@@ -0,0 +1,17 @@
+{-# OPTIONS -XRecursiveDo #-}
+
+-- This test, from Iavor Diatchki, made GHC 6.2 loop (testLoop) 
+-- or panic (testPanic); there was a Lint error.
+-- The reason was a missing bindInstsOfLocalFuns in tcStmtAndThen
+
+module ShouldCompile where
+
+import Control.Monad.Fix
+
+testLoop _  = mdo x <- mapM undefined (f x)
+                  let f _ = []
+                  return (f x)
+
+testPanic _  = mdo x <- f x
+                   let f _ = return ()
+                   f x
diff --git a/testsuite/tests/mdo/should_compile/mdo006.stderr b/testsuite/tests/mdo/should_compile/mdo006.stderr
new file mode 100644
index 0000000000..218ba444b8
--- /dev/null
+++ b/testsuite/tests/mdo/should_compile/mdo006.stderr
@@ -0,0 +1,3 @@
+
+mdo006.hs:1:12:
+    Warning: -XRecursiveDo is deprecated: use -XDoRec or pragma {-# LANGUAGE DoRec #-} instead