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

30 files changed, 370 insertions, 0 deletions

diff --git a/testsuite/tests/stranal/should_compile/Makefile b/testsuite/tests/stranal/should_compile/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/stranal/should_compile/T1988.hs b/testsuite/tests/stranal/should_compile/T1988.hs
new file mode 100644
index 0000000000..da99806ce1
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T1988.hs
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -O2 #-}
+
+-- Trac #1988: this one killed GHC 6.8.2
+-- 		at least with -O2
+
+module ShouldCompile where
+
+newtype CFTree = CFTree (String, [CFTree])
+
+prCFTree :: CFTree -> String
+prCFTree (CFTree (_,trees)) = concatMap ps trees
+    where ps t@(CFTree (_,[])) = prCFTree t
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
new file mode 100644
index 0000000000..5814f39f7d
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -0,0 +1,18 @@
+# Only compile with optimisation
+setTestOpts( only_ways(['optasm']) )
+
+test('default', normal, compile, [''])
+test('fact', normal, compile, [''])
+test('fun', normal, compile, [''])
+test('goo', normal, compile, [''])
+test('ins', normal, compile, [''])
+test('map', normal, compile, [''])
+test('sim', normal, compile, [''])
+test('str001', normal, compile, [''])
+test('str002', normal, compile, [''])
+test('syn', normal, compile, [''])
+test('test', normal, compile, [''])
+test('tst', normal, compile, [''])
+test('unu', normal, compile, [''])
+test('newtype', req_profiling, compile, ['-prof -auto-all'])
+test('T1988', normal, compile, [''])
diff --git a/testsuite/tests/stranal/should_compile/default.hs b/testsuite/tests/stranal/should_compile/default.hs
new file mode 100644
index 0000000000..43eb9f0633
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/default.hs
@@ -0,0 +1,16 @@
+module Test where
+data Boolean = FF | TT
+data Pair a b = MkPair a b
+data LList alpha = Nill | Conss alpha (LList alpha) 
+data Nat = Zero | Succ Nat
+data Tree x = Leaf x | Node (Tree x) (Tree x) 
+data A a = MkA a (A a) 
+
+append :: LList a -> LList a -> LList a
+append  xs ys  = case xs of
+                  Conss z zs  -> Conss z (append zs ys) 
+                  v -> ys
+
+
+
+
diff --git a/testsuite/tests/stranal/should_compile/default.stderr b/testsuite/tests/stranal/should_compile/default.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/default.stderr
diff --git a/testsuite/tests/stranal/should_compile/fact.hs b/testsuite/tests/stranal/should_compile/fact.hs
new file mode 100644
index 0000000000..9f23f9021e
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/fact.hs
@@ -0,0 +1,3 @@
+module Test where
+fact :: Int -> Int
+fact n = if n==0 then 2 else (fact n) * n
diff --git a/testsuite/tests/stranal/should_compile/fact.stderr b/testsuite/tests/stranal/should_compile/fact.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/fact.stderr
diff --git a/testsuite/tests/stranal/should_compile/fun.hs b/testsuite/tests/stranal/should_compile/fun.hs
new file mode 100644
index 0000000000..5bab460f3f
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/fun.hs
@@ -0,0 +1,6 @@
+module Test where
+data Fun = MkFun (Fun -> Fun)
+data LList a = Nill | Conss a (LList a)
+
+g :: Fun -> Fun
+g f = f
diff --git a/testsuite/tests/stranal/should_compile/fun.stderr b/testsuite/tests/stranal/should_compile/fun.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/fun.stderr
diff --git a/testsuite/tests/stranal/should_compile/goo.hs b/testsuite/tests/stranal/should_compile/goo.hs
new file mode 100644
index 0000000000..00282bb79e
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/goo.hs
@@ -0,0 +1,10 @@
+module Test where
+data Goo a = Gsimpl | Gcompl ([Goo a]) 
+data Moo a b = Msimple | Mcompl (Moo b a)
+
+
+idGoo :: Goo a -> Goo a
+idGoo x = x
+
+idMoo :: Moo a b -> Moo a b
+idMoo x = x
diff --git a/testsuite/tests/stranal/should_compile/goo.stderr b/testsuite/tests/stranal/should_compile/goo.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/goo.stderr
diff --git a/testsuite/tests/stranal/should_compile/ins.hs b/testsuite/tests/stranal/should_compile/ins.hs
new file mode 100644
index 0000000000..a50320cefa
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/ins.hs
@@ -0,0 +1,27 @@
+-- !! TEST OF DEFACTORISATION FOR FUNCTIONS THAT DROP 
+-- !!             POLYMORPHIC VARIABLES
+
+module Test where
+data Boolean = FF | TT
+data Pair a b = MkPair a b
+data LList alpha = Nill | Conss alpha (LList alpha) 
+data Nat = Zero | Succ Nat
+data Tree x = Leaf x | Node (Tree x) (Tree x) 
+data A a = MkA a (A a) 
+
+append :: LList a -> LList a -> LList a
+append  xs ys  = case xs of
+                  Nill -> ys 
+                  Conss z zs  -> Conss z (append zs ys) 
+
+-- The following function drops @b@.
+
+flat :: Tree (Pair a b) -> LList a
+flat t =  case t of
+              Leaf (MkPair a b) -> Conss a Nill 
+              Node l r -> append (flat l) (flat r)
+
+fl :: Boolean -> LList Boolean
+fl x = flat (Leaf (MkPair TT Zero)) 
+
+
diff --git a/testsuite/tests/stranal/should_compile/ins.stderr b/testsuite/tests/stranal/should_compile/ins.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/ins.stderr
diff --git a/testsuite/tests/stranal/should_compile/map.hs b/testsuite/tests/stranal/should_compile/map.hs
new file mode 100644
index 0000000000..f4ec1ec769
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/map.hs
@@ -0,0 +1,32 @@
+module Test where
+data Boolean = FF | TT
+data Pair a b = MkPair a b
+data LList alpha = Nill | Conss alpha (LList alpha) 
+data Nat = Zero | Succ Nat
+data Tree x = Leaf x | Node (Tree x) (Tree x) 
+data A a = MkA a (A a) 
+
+{-
+map :: (a -> b) -> [a] -> [b]
+map f xs = case xs of
+             []     -> []
+             (y:ys) -> (f y):(map f ys)
+
+map_ide :: [[a]] -> [[a]]
+map_ide = map (\x->x)
+-}
+
+my_id :: a -> a
+my_id x = x
+
+idNat :: Nat -> Nat
+idNat x = x
+
+idBool :: Boolean -> Boolean
+idBool x = x
+
+fun :: (a->b) -> a -> b
+fun f x = g f
+ where 
+  g f   = f x
+
diff --git a/testsuite/tests/stranal/should_compile/map.stderr b/testsuite/tests/stranal/should_compile/map.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/map.stderr
diff --git a/testsuite/tests/stranal/should_compile/newtype.hs b/testsuite/tests/stranal/should_compile/newtype.hs
new file mode 100644
index 0000000000..c68df28111
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/newtype.hs
@@ -0,0 +1,14 @@
+-- This one killed GHC 6.4 because it bogusly attributed 
+-- the CPR property to the construtor T
+-- Result: a mkWWcpr crash
+-- Needs -prof -auto-all to show it up
+
+module ShouldCompile where
+
+newtype T a = T { unT :: a }
+
+f = unT
+
+test cs = f $ case cs of
+		   [] -> T []
+		   (x:xs) -> T $ test cs
diff --git a/testsuite/tests/stranal/should_compile/sim.hs b/testsuite/tests/stranal/should_compile/sim.hs
new file mode 100644
index 0000000000..d6de6ec09d
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/sim.hs
@@ -0,0 +1,103 @@
+module Test where
+data Boolean = FF | TT
+data Pair a b = MkPair a b
+data LList alpha = Nill | Conss alpha (LList alpha) 
+data Nat = Zero | Succ Nat
+data Tree x = Leaf x | Node (Tree x) (Tree x) 
+data A a = MkA a (A a) 
+{-
+id :: a -> a
+id x = x      
+
+idb :: Boolean -> Boolean
+idb b = b
+
+swap :: Pair a b -> Pair b a
+swap t = case t of 
+           MkPair x y -> MkPair y x
+
+bang :: A (A a) -> Boolean
+bang x = case x of
+           MkA y ys -> TT
+
+neg :: Boolean -> Boolean
+neg b = case b of 
+         FF -> TT 
+         TT -> FF 
+
+null :: LList x -> Boolean
+null l = case l of 
+           Nill -> TT
+           _ -> FF
+
+loop :: Boolean -> a
+loop b = loop b
+-}
+idl ::  LList a -> LList a
+idl xs  = case xs of
+           Conss y ys -> Conss y (idl ys)
+           _ -> Nill 
+{-
+idn :: Nat -> Nat
+idn n = case n of
+          Zero -> Zero 
+          Succ m -> Succ (idn m)
+
+add :: Nat -> Nat -> Nat
+add a b = case a of 
+            Zero -> b
+            Succ c -> Succ (add c b) 
+
+length :: LList a -> Nat
+length xs = case xs of 
+              Nill -> Zero
+              Conss y ys  -> Succ(length ys) 
+
+before :: LList Nat -> LList Nat
+before xs = case xs of
+              Nill -> Nill
+              Conss y ys -> case y of 
+                             Zero -> Nill
+                             Succ n -> Conss y (before ys)     
+
+reverse :: LList a -> LList a
+reverse rs = case rs of
+               Nill -> Nill
+               Conss y ys -> append (reverse ys) (Conss y Nill) 
+
+f :: Nat -> Nat
+f n = case n of
+        Zero -> Zero
+        Succ m -> Succ (g m)
+
+g :: Nat -> Nat
+g n = case n of
+       Zero -> Zero
+       Succ m -> Succ (f m)
+
+append :: LList a -> LList a -> LList a
+append  xs ys  = case xs of
+                  Nill -> ys 
+                  Conss z zs  -> Conss z (append zs ys) 
+
+flatten :: Tree alpha -> LList alpha
+flatten t = case t of
+              Leaf x   -> Conss x Nill 
+              Node l r -> append (flatten l) (flatten r)
+
+sum :: Tree Nat -> Nat
+sum t = case t of
+          Leaf t   -> t
+          Node l r -> add (sum l) (sum r) 
+
+suml :: LList Nat -> Nat
+suml Nill = Zero
+suml (Conss n ns) = add n (suml ns)
+
+map :: (a -> b) -> LList a -> LList b
+map f xs = case xs of
+             Nill -> Nill
+             Conss y ys -> Conss (f y) (map f ys)
+-}
+
+
diff --git a/testsuite/tests/stranal/should_compile/sim.stderr b/testsuite/tests/stranal/should_compile/sim.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/sim.stderr
diff --git a/testsuite/tests/stranal/should_compile/str001.hs b/testsuite/tests/stranal/should_compile/str001.hs
new file mode 100644
index 0000000000..6d27a923fd
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/str001.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE DatatypeContexts #-}
+module ShouldSucceed where
+
+{-# OPTIONS -O #-}
+
+newtype Num a => Point2 a     = Point2 (a,a)
+
+area2 :: Num a => Point2 a -> Point2 a -> Point2 a -> a
+area2 (Point2 (px,py)) (Point2 (qx,qy)) (Point2 (rx,ry))
+     = (px-qx) * (py-ry) - (py-qy) * (px-rx)
diff --git a/testsuite/tests/stranal/should_compile/str001.stderr b/testsuite/tests/stranal/should_compile/str001.stderr
new file mode 100644
index 0000000000..968ccf8885
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/str001.stderr
@@ -0,0 +1,4 @@
+
+str001.hs:1:14:
+    Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
+
diff --git a/testsuite/tests/stranal/should_compile/str002.hs b/testsuite/tests/stranal/should_compile/str002.hs
new file mode 100644
index 0000000000..65fb8a7ba2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/str002.hs
@@ -0,0 +1,12 @@
+-- !!! Recursive newtypes
+-- 	Needs -O
+-- This one made GHC < 5.00.2 go into an 
+-- infinite loop in the strictness analysier
+
+module Foo where
+
+newtype V = MkV V
+
+f :: V -> V
+f (MkV v) = v
+
diff --git a/testsuite/tests/stranal/should_compile/str002.stderr b/testsuite/tests/stranal/should_compile/str002.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/str002.stderr
diff --git a/testsuite/tests/stranal/should_compile/syn.hs b/testsuite/tests/stranal/should_compile/syn.hs
new file mode 100644
index 0000000000..6693db70d9
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/syn.hs
@@ -0,0 +1,15 @@
+-- !!! THIS TEST IS FOR TYPE SYNONIMS AND FACTORISATION IN THEIR PRESENCE.
+
+module Test where
+data M a = A | B a (M a)
+data L a = N | C a (Syn a)
+type Syn b = L b
+
+idL :: L (Syn c) -> L (Syn c)
+idL N       = N
+idL (C x l) = C x (idL l) 
+
+idM:: M (L (Syn x)) -> M (L (Syn x))
+idM A       = A
+idM (B x l) = B (idL x) (idM l) 
+
diff --git a/testsuite/tests/stranal/should_compile/syn.stderr b/testsuite/tests/stranal/should_compile/syn.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/syn.stderr
diff --git a/testsuite/tests/stranal/should_compile/test.hs b/testsuite/tests/stranal/should_compile/test.hs
new file mode 100644
index 0000000000..c984c320d1
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/test.hs
@@ -0,0 +1,6 @@
+module Test where
+data LList t = Nill | Conss t (LList t)
+data BBool = TTrue | FFalse
+
+f Nill = TTrue
+f (Conss a as) = FFalse
diff --git a/testsuite/tests/stranal/should_compile/test.stderr b/testsuite/tests/stranal/should_compile/test.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/test.stderr
diff --git a/testsuite/tests/stranal/should_compile/tst.hs b/testsuite/tests/stranal/should_compile/tst.hs
new file mode 100644
index 0000000000..561292107b
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/tst.hs
@@ -0,0 +1,3 @@
+module Test where
+a :: [a] -> [[a]]
+a x = [x]
diff --git a/testsuite/tests/stranal/should_compile/tst.stderr b/testsuite/tests/stranal/should_compile/tst.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/tst.stderr
diff --git a/testsuite/tests/stranal/should_compile/unu.hs b/testsuite/tests/stranal/should_compile/unu.hs
new file mode 100644
index 0000000000..54bb25e9ab
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/unu.hs
@@ -0,0 +1,76 @@
+module Test where
+data Boolean = FF | TT
+data Pair a b = Mkpair a b
+data LList alpha = Nill | Conss alpha (LList alpha) 
+data Nat = Zero | Succ Nat
+data Tree t = Leaf t | Node (Tree t) (Tree t) 
+data A a = MkA a (A a) 
+data Foo baz = MkFoo (Foo (Foo baz))
+{-
+ append1 :: LList a -> LList a -> LList a
+ append1 xs ys = append2 xs
+   where
+     append2 xs = case xs of
+                    Nill -> ys
+                    Conss x xs -> Conss x (append3 xs)
+     append3 xs = case xs of
+                    Nill -> ys
+                    Conss x xs -> Conss x (append2 xs)
+
+ loop :: a -> a
+ loop x =  loop x
+
+ hd :: LList b -> b
+ hd Nill         = loop
+ hd (Conss y ys) = y
+
+ hdb :: LList (LList b) -> LList b
+ hdb = hd
+
+ append :: [a] -> [a] -> [a]
+ append [] ys     = ys
+ append (x:xs) ys = x:(append xs ys)
+ 
+ f :: [a] -> [a]
+ f y = append x (f y)
+   where  x = append x (f y)
+-}
+app :: LList a -> LList a -> LList a
+app Nill Nill = Nill
+app  xs ys  = case xs of
+                Nill -> ys 
+                Conss z zs  -> Conss z (app zs ys) 
+{-
+ app :: LList a -> LList a -> LList a
+ app  xs ys = case xs of
+               Nill -> case ys of
+                        Nill -> Nill
+                        Conss u us -> ap 
+               Conss a as -> ap 
+  where ap = case xs of
+              Nill -> ys 
+              Conss z zs  -> Conss z (app zs ys) 
+
+ app :: LList a -> LList a -> LList a
+ app  xs ys = case xs of
+               Nill -> case ys of
+                        Nill -> Nill
+                        Conss u us -> ap xs ys
+               Conss a as -> ap xs ys
+
+ ap xs ys = case xs of
+              Nill -> ys 
+              Conss z zs  -> Conss z (app zs ys) 
+
+ ap :: LList a -> LList a -> LList a
+ ap  xs ys  = case xs of
+                 Nill -> ys 
+                 Conss z zs  -> Conss z (ap zs ys) 
+
+ app :: LList a -> LList a -> LList a
+ app  xs ys = case xs of
+               Nill -> case ys of
+                        Nill -> Nill
+                        Conss u us -> ap xs ys
+               Conss a as -> ap xs ys
+-}
diff --git a/testsuite/tests/stranal/should_compile/unu.stderr b/testsuite/tests/stranal/should_compile/unu.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/unu.stderr