Move tests from tests/ghc-regress/* to just tests/*

8 files changed, 113 insertions, 0 deletions

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,())