summaryrefslogtreecommitdiff
path: root/testsuite/tests/mdo
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/mdo')
-rw-r--r--testsuite/tests/mdo/Makefile3
-rw-r--r--testsuite/tests/mdo/should_compile/Makefile3
-rw-r--r--testsuite/tests/mdo/should_compile/all.T8
-rw-r--r--testsuite/tests/mdo/should_compile/mdo001.hs36
-rw-r--r--testsuite/tests/mdo/should_compile/mdo001.stdout5
-rw-r--r--testsuite/tests/mdo/should_compile/mdo002.hs23
-rw-r--r--testsuite/tests/mdo/should_compile/mdo002.stdout1
-rw-r--r--testsuite/tests/mdo/should_compile/mdo003.hs16
-rw-r--r--testsuite/tests/mdo/should_compile/mdo003.stdout1
-rw-r--r--testsuite/tests/mdo/should_compile/mdo004.hs17
-rw-r--r--testsuite/tests/mdo/should_compile/mdo004.stdout1
-rw-r--r--testsuite/tests/mdo/should_compile/mdo005.hs15
-rw-r--r--testsuite/tests/mdo/should_compile/mdo005.stdout1
-rw-r--r--testsuite/tests/mdo/should_compile/mdo006.hs17
-rw-r--r--testsuite/tests/mdo/should_compile/mdo006.stderr3
-rw-r--r--testsuite/tests/mdo/should_fail/Makefile3
-rw-r--r--testsuite/tests/mdo/should_fail/all.T7
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail001.hs16
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail001.stderr11
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail001.stderr-ghc-7.08
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail001.stderr-hugs1
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail002.hs15
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail002.stderr8
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail002.stderr-ghc-7.05
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail002.stderr-hugs1
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail003.hs15
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail003.stderr8
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail003.stderr-ghc-7.05
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail003.stderr-hugs1
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail004.hs22
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail004.stderr3
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail004.stderr-ghc-7.07
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail004.stderr-hugs1
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail005.hs12
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail005.stderr2
-rw-r--r--testsuite/tests/mdo/should_fail/mdofail005.stderr-hugs1
-rw-r--r--testsuite/tests/mdo/should_run/Makefile3
-rw-r--r--testsuite/tests/mdo/should_run/all.T5
-rw-r--r--testsuite/tests/mdo/should_run/mdorun001.hs33
-rw-r--r--testsuite/tests/mdo/should_run/mdorun001.stdout5
-rw-r--r--testsuite/tests/mdo/should_run/mdorun002.hs56
-rw-r--r--testsuite/tests/mdo/should_run/mdorun002.stdout1
-rw-r--r--testsuite/tests/mdo/should_run/mdorun003.hs8
-rw-r--r--testsuite/tests/mdo/should_run/mdorun003.stdout2
44 files changed, 415 insertions, 0 deletions
diff --git a/testsuite/tests/mdo/Makefile b/testsuite/tests/mdo/Makefile
new file mode 100644
index 0000000000..9a36a1c5fe
--- /dev/null
+++ b/testsuite/tests/mdo/Makefile
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
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
diff --git a/testsuite/tests/mdo/should_fail/Makefile b/testsuite/tests/mdo/should_fail/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/mdo/should_fail/all.T b/testsuite/tests/mdo/should_fail/all.T
new file mode 100644
index 0000000000..6693587bab
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/all.T
@@ -0,0 +1,7 @@
+setTestOpts(only_ways(['normal']));
+
+test('mdofail001', normal, compile_fail, [''])
+test('mdofail002', normal, compile_fail, [''])
+test('mdofail003', normal, compile_fail, [''])
+test('mdofail004', normal, compile, [''])
+test('mdofail005', normal, compile_fail, [''])
diff --git a/testsuite/tests/mdo/should_fail/mdofail001.hs b/testsuite/tests/mdo/should_fail/mdofail001.hs
new file mode 100644
index 0000000000..fe8f95e766
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail001.hs
@@ -0,0 +1,16 @@
+{-# OPTIONS -XRecursiveDo #-}
+
+-- let bindings are monomorphic if used prior to their definition
+
+module Main (main) where
+
+import Control.Monad.Fix
+
+t :: IO (Int, Int)
+t = mdo x <- return (l "1", l [1,2,3])
+ let l [] = 0
+ l (x:xs) = 1 + l xs
+ return x
+
+main :: IO ()
+main = t >>= print
diff --git a/testsuite/tests/mdo/should_fail/mdofail001.stderr b/testsuite/tests/mdo/should_fail/mdofail001.stderr
new file mode 100644
index 0000000000..8660e167fe
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail001.stderr
@@ -0,0 +1,11 @@
+
+mdofail001.hs:1:12:
+ Warning: -XRecursiveDo is deprecated: use -XDoRec or pragma {-# LANGUAGE DoRec #-} instead
+
+mdofail001.hs:10:36:
+ No instance for (Num Char)
+ arising from the literal `3'
+ Possible fix: add an instance declaration for (Num Char)
+ In the expression: 3
+ In the first argument of `l', namely `[1, 2, 3]'
+ In the expression: l [1, 2, 3]
diff --git a/testsuite/tests/mdo/should_fail/mdofail001.stderr-ghc-7.0 b/testsuite/tests/mdo/should_fail/mdofail001.stderr-ghc-7.0
new file mode 100644
index 0000000000..189c414315
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail001.stderr-ghc-7.0
@@ -0,0 +1,8 @@
+
+mdofail001.hs:10:36:
+ No instance for (Num Char)
+ arising from the literal `3'
+ Possible fix: add an instance declaration for (Num Char)
+ In the expression: 3
+ In the first argument of `l', namely `[1, 2, 3]'
+ In the expression: l [1, 2, 3]
diff --git a/testsuite/tests/mdo/should_fail/mdofail001.stderr-hugs b/testsuite/tests/mdo/should_fail/mdofail001.stderr-hugs
new file mode 100644
index 0000000000..3bfe41e9f4
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail001.stderr-hugs
@@ -0,0 +1 @@
+ERROR "mdofail001.hs":10 - Instance of Num Char required for definition of t
diff --git a/testsuite/tests/mdo/should_fail/mdofail002.hs b/testsuite/tests/mdo/should_fail/mdofail002.hs
new file mode 100644
index 0000000000..27c9861f38
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail002.hs
@@ -0,0 +1,15 @@
+{-# OPTIONS -XRecursiveDo #-}
+
+-- shadowing is not allowed
+
+module Main (main) where
+
+import Control.Monad.Fix
+
+t :: IO ()
+t = mdo x <- return 1
+ x <- return 2
+ return ()
+
+main :: IO ()
+main = t
diff --git a/testsuite/tests/mdo/should_fail/mdofail002.stderr b/testsuite/tests/mdo/should_fail/mdofail002.stderr
new file mode 100644
index 0000000000..4da766311e
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail002.stderr
@@ -0,0 +1,8 @@
+
+mdofail002.hs:1:12:
+ Warning: -XRecursiveDo is deprecated: use -XDoRec or pragma {-# LANGUAGE DoRec #-} instead
+
+mdofail002.hs:10:9:
+ Conflicting definitions for `x'
+ Bound at: mdofail002.hs:10:9
+ mdofail002.hs:11:9
diff --git a/testsuite/tests/mdo/should_fail/mdofail002.stderr-ghc-7.0 b/testsuite/tests/mdo/should_fail/mdofail002.stderr-ghc-7.0
new file mode 100644
index 0000000000..a1327c6dfd
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail002.stderr-ghc-7.0
@@ -0,0 +1,5 @@
+
+mdofail002.hs:10:9:
+ Conflicting definitions for `x'
+ Bound at: mdofail002.hs:10:9
+ mdofail002.hs:11:9
diff --git a/testsuite/tests/mdo/should_fail/mdofail002.stderr-hugs b/testsuite/tests/mdo/should_fail/mdofail002.stderr-hugs
new file mode 100644
index 0000000000..4f1c0a0bb4
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail002.stderr-hugs
@@ -0,0 +1 @@
+ERROR "mdofail002.hs":10 - Repeated use of variable "x" in pattern binding
diff --git a/testsuite/tests/mdo/should_fail/mdofail003.hs b/testsuite/tests/mdo/should_fail/mdofail003.hs
new file mode 100644
index 0000000000..ba7e80a74b
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail003.hs
@@ -0,0 +1,15 @@
+{-# OPTIONS -XRecursiveDo #-}
+
+-- shadowing is not allowed II
+
+module Main (main) where
+
+import Control.Monad.Fix
+
+t :: IO ()
+t = mdo x <- return 1
+ let x 0 = 4
+ return ()
+
+main :: IO ()
+main = t
diff --git a/testsuite/tests/mdo/should_fail/mdofail003.stderr b/testsuite/tests/mdo/should_fail/mdofail003.stderr
new file mode 100644
index 0000000000..fceb7d2b82
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail003.stderr
@@ -0,0 +1,8 @@
+
+mdofail003.hs:1:12:
+ Warning: -XRecursiveDo is deprecated: use -XDoRec or pragma {-# LANGUAGE DoRec #-} instead
+
+mdofail003.hs:10:9:
+ Conflicting definitions for `x'
+ Bound at: mdofail003.hs:10:9
+ mdofail003.hs:11:13
diff --git a/testsuite/tests/mdo/should_fail/mdofail003.stderr-ghc-7.0 b/testsuite/tests/mdo/should_fail/mdofail003.stderr-ghc-7.0
new file mode 100644
index 0000000000..e093fe0a75
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail003.stderr-ghc-7.0
@@ -0,0 +1,5 @@
+
+mdofail003.hs:10:9:
+ Conflicting definitions for `x'
+ Bound at: mdofail003.hs:10:9
+ mdofail003.hs:11:13
diff --git a/testsuite/tests/mdo/should_fail/mdofail003.stderr-hugs b/testsuite/tests/mdo/should_fail/mdofail003.stderr-hugs
new file mode 100644
index 0000000000..ef14fdcff3
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail003.stderr-hugs
@@ -0,0 +1 @@
+ERROR "mdofail003.hs":10 - Repeated use of variable "x" in pattern binding
diff --git a/testsuite/tests/mdo/should_fail/mdofail004.hs b/testsuite/tests/mdo/should_fail/mdofail004.hs
new file mode 100644
index 0000000000..37cd757312
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail004.hs
@@ -0,0 +1,22 @@
+{-# OPTIONS -XRecursiveDo #-}
+
+-- OLD: mdo requires MonadFix instance, even
+-- if no recursion is present
+
+-- Dec 2010: Small change of behaviour
+-- MonadFix is only required if recursion is present
+
+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
+
+z :: X [Int]
+z = mdo { a <- return 1; return [a] }
+
+main = print z
diff --git a/testsuite/tests/mdo/should_fail/mdofail004.stderr b/testsuite/tests/mdo/should_fail/mdofail004.stderr
new file mode 100644
index 0000000000..7a96d65197
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail004.stderr
@@ -0,0 +1,3 @@
+
+mdofail004.hs:1:12:
+ Warning: -XRecursiveDo is deprecated: use -XDoRec or pragma {-# LANGUAGE DoRec #-} instead
diff --git a/testsuite/tests/mdo/should_fail/mdofail004.stderr-ghc-7.0 b/testsuite/tests/mdo/should_fail/mdofail004.stderr-ghc-7.0
new file mode 100644
index 0000000000..63c0cae6ac
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail004.stderr-ghc-7.0
@@ -0,0 +1,7 @@
+
+mdofail004.hs:17:5:
+ No instance for (MonadFix X)
+ arising from a do statement
+ Possible fix: add an instance declaration for (MonadFix X)
+ In the expression: mdo { return [1, 2, ....] }
+ In an equation for `z': z = mdo { return [1, ....] }
diff --git a/testsuite/tests/mdo/should_fail/mdofail004.stderr-hugs b/testsuite/tests/mdo/should_fail/mdofail004.stderr-hugs
new file mode 100644
index 0000000000..c787c4209b
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail004.stderr-hugs
@@ -0,0 +1 @@
+ERROR "mdofail004.hs":17 - Instance of MonadFix X required for definition of z
diff --git a/testsuite/tests/mdo/should_fail/mdofail005.hs b/testsuite/tests/mdo/should_fail/mdofail005.hs
new file mode 100644
index 0000000000..b4d52918a5
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail005.hs
@@ -0,0 +1,12 @@
+
+
+-- use of mdo requires an extension,
+-- so let's try not enabling it
+
+module Main (main) where
+
+import Control.Monad.Fix
+
+main :: IO ()
+main = mdo x <- return (1:x)
+ return ()
diff --git a/testsuite/tests/mdo/should_fail/mdofail005.stderr b/testsuite/tests/mdo/should_fail/mdofail005.stderr
new file mode 100644
index 0000000000..306df25706
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail005.stderr
@@ -0,0 +1,2 @@
+
+mdofail005.hs:11:14: parse error on input `<-'
diff --git a/testsuite/tests/mdo/should_fail/mdofail005.stderr-hugs b/testsuite/tests/mdo/should_fail/mdofail005.stderr-hugs
new file mode 100644
index 0000000000..6bb11378a1
--- /dev/null
+++ b/testsuite/tests/mdo/should_fail/mdofail005.stderr-hugs
@@ -0,0 +1 @@
+ERROR "mdofail005.hs":11 - Syntax error in input (unexpected `<-')
diff --git a/testsuite/tests/mdo/should_run/Makefile b/testsuite/tests/mdo/should_run/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/mdo/should_run/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/mdo/should_run/all.T b/testsuite/tests/mdo/should_run/all.T
new file mode 100644
index 0000000000..53730bebe6
--- /dev/null
+++ b/testsuite/tests/mdo/should_run/all.T
@@ -0,0 +1,5 @@
+setTestOpts(only_ways(['normal']));
+
+test('mdorun001', normal, compile_and_run, [''])
+test('mdorun002', normal, compile_and_run, [''])
+test('mdorun003', normal, compile_and_run, [''])
diff --git a/testsuite/tests/mdo/should_run/mdorun001.hs b/testsuite/tests/mdo/should_run/mdorun001.hs
new file mode 100644
index 0000000000..8527e5b2b1
--- /dev/null
+++ b/testsuite/tests/mdo/should_run/mdorun001.hs
@@ -0,0 +1,33 @@
+{-# OPTIONS -XRecursiveDo -XScopedTypeVariables #-}
+
+module Main(main) where
+
+import Control.Monad.Fix
+import Data.Array.IO
+import Control.Monad
+
+norm a = mdo (_, sz) <- getBounds a
+ s <- ioaA 1 s sz 0
+ return ()
+ where
+ ioaA i s sz acc
+ | i > sz = return acc
+ | True = do v <- readArray a i
+ writeArray a i (v / s)
+ ioaA (i+1) s sz $! (v + acc)
+
+toList a = do (_, sz) <- getBounds a
+ mapM (\i -> readArray a i) [1..sz]
+
+test :: Int -> IO ()
+test sz = do
+ (arr :: IOArray Int Float) <- newArray (1, sz) 12
+ putStrLn "Before: "
+ toList arr >>= print
+ norm arr
+ putStrLn "After: "
+ lst <- toList arr
+ print lst
+ putStrLn ("Normalized sum: " ++ show (sum lst))
+
+main = test 10
diff --git a/testsuite/tests/mdo/should_run/mdorun001.stdout b/testsuite/tests/mdo/should_run/mdorun001.stdout
new file mode 100644
index 0000000000..7b0453fcf9
--- /dev/null
+++ b/testsuite/tests/mdo/should_run/mdorun001.stdout
@@ -0,0 +1,5 @@
+Before:
+[12.0,12.0,12.0,12.0,12.0,12.0,12.0,12.0,12.0,12.0]
+After:
+[0.1,0.1,0.1,0.1,0.1,0.1,0.1,0.1,0.1,0.1]
+Normalized sum: 1.0000001
diff --git a/testsuite/tests/mdo/should_run/mdorun002.hs b/testsuite/tests/mdo/should_run/mdorun002.hs
new file mode 100644
index 0000000000..191e40039d
--- /dev/null
+++ b/testsuite/tests/mdo/should_run/mdorun002.hs
@@ -0,0 +1,56 @@
+{-# OPTIONS -XRecursiveDo #-}
+
+module Main(main) where
+
+import Control.Monad.Fix
+import Control.Monad.ST
+import Data.STRef
+
+newtype Node s a = N (STRef s Bool, Node s a, a, Node s a)
+
+newNode :: Node s a -> a -> Node s a -> ST s (Node s a)
+newNode b c f = do v <- newSTRef False
+ return (N (v, b, c, f))
+
+ll :: ST s (Node s Int)
+ll = mdo n0 <- newNode n3 0 n1
+ n1 <- newNode n0 1 n2
+ n2 <- newNode n1 2 n3
+ n3 <- newNode n2 3 n0
+ return n0
+
+data Direction = Forward | Backward deriving Eq
+
+traverse :: Direction -> Node s a -> ST s [a]
+traverse dir (N (v, b, i, f)) =
+ do visited <- readSTRef v
+ if visited
+ then return []
+ else do writeSTRef v True
+ let n = if dir == Forward then f else b
+ is <- traverse dir n
+ return (i:is)
+
+l2dll :: [a] -> ST s (Node s a)
+l2dll (x:xs) = mdo c <- newNode l x f
+ (f, l) <- l2dll' c xs
+ return c
+
+l2dll' :: Node s a -> [a] -> ST s (Node s a, Node s a)
+l2dll' p [] = return (p, p)
+l2dll' p (x:xs) = mdo c <- newNode p x f
+ (f, l) <- l2dll' c xs
+ return (c, l)
+
+insertAfter :: Node s a -> a -> ST s (Node s a)
+insertAfter cur@(N (v, prev, val, next)) i
+ = do vis <- newSTRef False
+ let newCell = N (vis, cur, i, next)
+ return (N (v, prev, val, newCell))
+
+test = runST (do l <- l2dll [1 .. 10]
+ l' <- insertAfter l 12
+ l'' <- insertAfter l' 13
+ traverse Forward l'')
+
+main = print test
diff --git a/testsuite/tests/mdo/should_run/mdorun002.stdout b/testsuite/tests/mdo/should_run/mdorun002.stdout
new file mode 100644
index 0000000000..34df74ba96
--- /dev/null
+++ b/testsuite/tests/mdo/should_run/mdorun002.stdout
@@ -0,0 +1 @@
+[1,13,12,2,3,4,5,6,7,8,9,10]
diff --git a/testsuite/tests/mdo/should_run/mdorun003.hs b/testsuite/tests/mdo/should_run/mdorun003.hs
new file mode 100644
index 0000000000..f818afa56a
--- /dev/null
+++ b/testsuite/tests/mdo/should_run/mdorun003.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE DoRec #-}
+
+main :: IO ()
+main = do x <- return (length [1 .. 42 :: Int])
+ rec b <- return x
+ let a = const c
+ c <- print "x"
+ print (b, a b)
diff --git a/testsuite/tests/mdo/should_run/mdorun003.stdout b/testsuite/tests/mdo/should_run/mdorun003.stdout
new file mode 100644
index 0000000000..912f3a2a53
--- /dev/null
+++ b/testsuite/tests/mdo/should_run/mdorun003.stdout
@@ -0,0 +1,2 @@
+"x"
+(42,())