From 75eadc4bb302c0f4f78a6921c68e9d6aa35a070d Mon Sep 17 00:00:00 2001 From: simonpj Date: Fri, 26 Jan 2001 10:01:39 +0000 Subject: [PATCH] [project @ 2001-01-26 10:01:39 by simonpj] Add a few new tests --- ghc/tests/ccall/should_run/ffi001.hs | 19 ++++++++++ ghc/tests/ccall/should_run/ffi001.stdout | 16 ++++++++ ghc/tests/codeGen/should_run/cg045.hs | 1 + ghc/tests/deriving/should_fail/drvfail004.hs | 1 + ghc/tests/rename/should_fail/rnfail026.hs | 19 ++++++++++ ghc/tests/typecheck/should_fail/tcfail036.stderr | 8 ---- ghc/tests/typecheck/should_run/tcrun009.hs | 25 ++++++++++++ ghc/tests/typecheck/should_run/tcrun009.stdout | 1 + ghc/tests/typecheck/should_run/tcrun010.hs | 44 ++++++++++++++++++++++ ghc/tests/typecheck/should_run/tcrun010.stdout | 1 + 10 files changed, 127 insertions(+), 8 deletions(-) create mode 100644 ghc/tests/ccall/should_run/ffi001.hs create mode 100644 ghc/tests/ccall/should_run/ffi001.stdout create mode 100644 ghc/tests/rename/should_fail/rnfail026.hs create mode 100644 ghc/tests/typecheck/should_run/tcrun009.hs create mode 100644 ghc/tests/typecheck/should_run/tcrun009.stdout create mode 100644 ghc/tests/typecheck/should_run/tcrun010.hs create mode 100644 ghc/tests/typecheck/should_run/tcrun010.stdout diff --git a/ghc/tests/ccall/should_run/ffi001.hs b/ghc/tests/ccall/should_run/ffi001.hs new file mode 100644 index 0000000..16e8a76 --- /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: .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 Int -> Int + +main = putStrLn "No bug" + +mygcd a b = if (a==b) then a + else if (a b -> b diff --git a/ghc/tests/deriving/should_fail/drvfail004.hs b/ghc/tests/deriving/should_fail/drvfail004.hs index 6e090d8..8716a58 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 0000000..8dcd154 --- /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 e6636c2..53cea4c 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 0000000..328614f --- /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 0000000..ed18a21 --- /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 0000000..1dec290 --- /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 0000000..8d1c8b6 --- /dev/null +++ b/ghc/tests/typecheck/should_run/tcrun010.stdout @@ -0,0 +1 @@ + -- 1.7.10.4