summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ghc/tests/ccall/should_run/ffi001.hs19
-rw-r--r--ghc/tests/ccall/should_run/ffi001.stdout16
-rw-r--r--ghc/tests/codeGen/should_run/cg045.hs1
-rw-r--r--ghc/tests/deriving/should_fail/drvfail004.hs1
-rw-r--r--ghc/tests/rename/should_fail/rnfail026.hs19
-rw-r--r--ghc/tests/typecheck/should_fail/tcfail036.stderr8
-rw-r--r--ghc/tests/typecheck/should_run/tcrun009.hs25
-rw-r--r--ghc/tests/typecheck/should_run/tcrun009.stdout1
-rw-r--r--ghc/tests/typecheck/should_run/tcrun010.hs44
-rw-r--r--ghc/tests/typecheck/should_run/tcrun010.stdout1
10 files changed, 127 insertions, 8 deletions
diff --git a/ghc/tests/ccall/should_run/ffi001.hs b/ghc/tests/ccall/should_run/ffi001.hs
new file mode 100644
index 0000000000..16e8a76753
--- /dev/null
+++ b/ghc/tests/ccall/should_run/ffi001.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+-- !!! A simple FFI test
+
+-- This one provoked a bogus renamer error in 4.08.1:
+-- panic: tcLookupGlobalValue: <THIS>.PrelIOBase.returnIO{-0B,s-}
+-- (the error was actually in DsMonad.dsLookupGlobalValue!)
+
+module Main where
+
+import Foreign
+
+foreign export ccall "gccd" mygcd :: Int -> Int -> Int
+
+main = putStrLn "No bug"
+
+mygcd a b = if (a==b) then a
+ else if (a<b) then mygcd a (b-a)
+ else mygcd (a-b) a
diff --git a/ghc/tests/ccall/should_run/ffi001.stdout b/ghc/tests/ccall/should_run/ffi001.stdout
new file mode 100644
index 0000000000..3758fb7549
--- /dev/null
+++ b/ghc/tests/ccall/should_run/ffi001.stdout
@@ -0,0 +1,16 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+-- !!! A simple FFI test
+-- This one provoked a bogus renamer error in 4.08.1:
+--
+module Main where
+
+import Foreign
+
+foreign export ccall "gccd" mygcd :: Int -> Int -> Int
+
+main = putStrLn "No bug"
+
+mygcd a b = if (a==b) then a
+ else if (a<b) then mygcd a (b-a)
+ else mygcd (a-b) a
diff --git a/ghc/tests/codeGen/should_run/cg045.hs b/ghc/tests/codeGen/should_run/cg045.hs
index 86d239cc3b..431a7eb96f 100644
--- a/ghc/tests/codeGen/should_run/cg045.hs
+++ b/ghc/tests/codeGen/should_run/cg045.hs
@@ -5,6 +5,7 @@ module Main (main,myseq) where
import PrelGHC
import PrelErr
+main :: IO ()
main = seq (error "hello world!" :: Int) (return ())
myseq :: a -> b -> b
diff --git a/ghc/tests/deriving/should_fail/drvfail004.hs b/ghc/tests/deriving/should_fail/drvfail004.hs
index 6e090d8fe1..8716a5837f 100644
--- a/ghc/tests/deriving/should_fail/drvfail004.hs
+++ b/ghc/tests/deriving/should_fail/drvfail004.hs
@@ -6,3 +6,4 @@ data Foo a b
= C1 a Int
| C2 b Double
deriving Ord
+
diff --git a/ghc/tests/rename/should_fail/rnfail026.hs b/ghc/tests/rename/should_fail/rnfail026.hs
new file mode 100644
index 0000000000..8dcd1542a0
--- /dev/null
+++ b/ghc/tests/rename/should_fail/rnfail026.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+-- This one made ghc-4.08 crash
+-- rename/RnEnv.lhs:239: Non-exhaustive patterns in function get_tycon_key
+-- The type in the Monad instance is utterly bogus, of course
+
+module ShouldCompile ( Set ) where
+
+
+data Set a = Set [a]
+ deriving (Eq, Ord, Read, Show)
+
+instance Functor Set where
+ f `fmap` (Set xs) = Set $ f `fmap` xs
+
+instance Monad (forall a. Eq a => Set a) where
+ return x = Set [x]
+
+instance Eq (forall a. [a]) where
diff --git a/ghc/tests/typecheck/should_fail/tcfail036.stderr b/ghc/tests/typecheck/should_fail/tcfail036.stderr
index e6636c2ef3..53cea4c68d 100644
--- a/ghc/tests/typecheck/should_fail/tcfail036.stderr
+++ b/ghc/tests/typecheck/should_fail/tcfail036.stderr
@@ -3,14 +3,6 @@ Duplicate or overlapping instance declarations:
tcfail036.hs:6: {Num NUM}
tcfail036.hs:8: {Num NUM}
-tcfail036.hs:8:
- No instance for `Eq NUM'
- arising from an instance declaration at tcfail036.hs:8
-
-tcfail036.hs:8:
- No instance for `Show NUM'
- arising from an instance declaration at tcfail036.hs:8
-
tcfail036.hs:9:
Class `Num' used as a type
When checking kinds in `Eq Num'
diff --git a/ghc/tests/typecheck/should_run/tcrun009.hs b/ghc/tests/typecheck/should_run/tcrun009.hs
new file mode 100644
index 0000000000..328614fdb3
--- /dev/null
+++ b/ghc/tests/typecheck/should_run/tcrun009.hs
@@ -0,0 +1,25 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+-- !!! Functional dependencies
+
+module Main where
+
+class Foo a b | a -> b where
+ foo :: a -> b
+
+instance Foo [a] (Maybe a) where
+ foo [] = Nothing
+ foo (x:_) = Just x
+
+instance Foo (Maybe a) [a] where
+ foo Nothing = []
+ foo (Just x) = [x]
+
+test3:: [a] -> [b]
+test3 = foo . foo
+-- First foo must use the first instance,
+-- second must use the second. So we should
+-- get in effect: test3 (x:xs) = [x]
+
+main:: IO ()
+main = print (test3 "foo" :: [Int])
diff --git a/ghc/tests/typecheck/should_run/tcrun009.stdout b/ghc/tests/typecheck/should_run/tcrun009.stdout
new file mode 100644
index 0000000000..ed18a21b42
--- /dev/null
+++ b/ghc/tests/typecheck/should_run/tcrun009.stdout
@@ -0,0 +1 @@
+['f']
diff --git a/ghc/tests/typecheck/should_run/tcrun010.hs b/ghc/tests/typecheck/should_run/tcrun010.hs
new file mode 100644
index 0000000000..1dec290064
--- /dev/null
+++ b/ghc/tests/typecheck/should_run/tcrun010.hs
@@ -0,0 +1,44 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+-- !!! Functional dependencies
+-- This one gave "zonkIdOcc: FunDep_a11w" in earlier days
+
+module Main (main) where
+
+data ERR a b = EOK a | ERR b deriving (Show)
+data Error = No | Notatall deriving (Show, Eq)
+
+
+class MonadErr m e | m -> e where
+ aerturn :: e -> m a
+ areturn :: a -> m a
+ acatch :: a -> (a -> m b) -> (e -> m b) -> m b
+ (>>>=) :: m a -> (a -> m b) -> m b
+ (>>>) :: m a -> m b -> m b
+
+data BP a = BP (Int -> (ERR a Error, Int))
+
+instance MonadErr BP Error where
+ aerturn k = BP $ \s -> (ERR k, s)
+ areturn k = BP $ \s -> (EOK k, s)
+ acatch k try handler = BP $ \s -> let BP try' = try k
+ (r,s1) = try' s
+ (BP c2, s2) = case r of
+ EOK r -> (areturn r, s1)
+ ERR r -> (handler r, s)
+ in c2 s2
+ a >>> b = a >>>= \_ -> b
+
+ (BP c1) >>>= fc2 = BP $ \s0 -> let (r,s1) = c1 s0
+ BP c2 = case r of
+ EOK r -> fc2 r
+ ERR r -> BP (\s -> (ERR r, s))
+ in c2 s1
+
+run_BP :: Int -> BP a -> (ERR a Error, Int)
+run_BP st (BP bp) = bp st
+
+foo :: (ERR Int Error, Int)
+foo = run_BP 111 (aerturn No)
+
+main = print (show foo)
diff --git a/ghc/tests/typecheck/should_run/tcrun010.stdout b/ghc/tests/typecheck/should_run/tcrun010.stdout
new file mode 100644
index 0000000000..8d1c8b69c3
--- /dev/null
+++ b/ghc/tests/typecheck/should_run/tcrun010.stdout
@@ -0,0 +1 @@
+