diff options
Diffstat (limited to 'testsuite/tests/deriving/should_run')
61 files changed, 634 insertions, 0 deletions
diff --git a/testsuite/tests/deriving/should_run/Makefile b/testsuite/tests/deriving/should_run/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/deriving/should_run/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/deriving/should_run/T2529.hs b/testsuite/tests/deriving/should_run/T2529.hs new file mode 100644 index 0000000000..d3c3a4b0a3 --- /dev/null +++ b/testsuite/tests/deriving/should_run/T2529.hs @@ -0,0 +1,21 @@ +-- Trac #2529 +-- The example below successfully performed the {{{show}}}, but {{{reads}}} +-- returns an empty list. It fails in both GHCi and GHC. It succeeds if you +-- replaces the infix symbol with a name. + +module Main where + +data A = (:<>:) { x :: Int, y :: Int } deriving (Read, Show) + +t :: A +t = 1 :<>: 2 + +s :: String +s = show t + +r :: [(A,String)] +r = reads s + +main :: IO () +main = do putStrLn s + putStrLn (show r) diff --git a/testsuite/tests/deriving/should_run/T2529.stdout b/testsuite/tests/deriving/should_run/T2529.stdout new file mode 100644 index 0000000000..6c5fe6896f --- /dev/null +++ b/testsuite/tests/deriving/should_run/T2529.stdout @@ -0,0 +1,2 @@ +(:<>:) {x = 1, y = 2} +[((:<>:) {x = 1, y = 2},"")] diff --git a/testsuite/tests/deriving/should_run/T3087.hs b/testsuite/tests/deriving/should_run/T3087.hs new file mode 100644 index 0000000000..7cba3d9609 --- /dev/null +++ b/testsuite/tests/deriving/should_run/T3087.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE RankNTypes, DeriveDataTypeable #-} + +module Main where + +import Data.Generics + +data MyMaybe a = MyNothing | MyJust a deriving (Data, Typeable) + +test1 :: () +test1 = undefined `ext1Q` (\ (Just _) -> ()) $ Just () + +test1' :: () +test1' = undefined `ext1Q` (\ (MyJust _) -> ()) $ MyJust () + +newtype Q r a = Q { unQ :: a -> r } + +ext2Q :: (Data d, Typeable2 t) + => (d -> q) -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) + -> d -> q +ext2Q def ext arg = + case dataCast2 (Q ext) of + Just (Q ext') -> ext' arg + Nothing -> def arg + +data MyPair a b = MyPair a b deriving (Data, Typeable) + +test2 :: () +test2 = undefined `ext2Q` (\(_,_) -> ()) $ ((),()) + +test2' :: () +test2' = undefined `ext2Q` (\(MyPair _ _) -> ()) $ MyPair () () + +main = do { print test1; print test1'; print test2; print test2' } diff --git a/testsuite/tests/deriving/should_run/T3087.stdout b/testsuite/tests/deriving/should_run/T3087.stdout new file mode 100644 index 0000000000..35735b4d3b --- /dev/null +++ b/testsuite/tests/deriving/should_run/T3087.stdout @@ -0,0 +1,4 @@ +() +() +() +() diff --git a/testsuite/tests/deriving/should_run/T4136.hs b/testsuite/tests/deriving/should_run/T4136.hs new file mode 100644 index 0000000000..d47014bdb0 --- /dev/null +++ b/testsuite/tests/deriving/should_run/T4136.hs @@ -0,0 +1,9 @@ +module Main where
+
+data T = (:=:) {- | (:!=:) -} deriving (Show,Read)
+
+main
+ = do putStrLn ("show (:=:) = " ++ show (:=:))
+ putStrLn ("read (show (:=:)) :: T = " ++
+ show (read (show (:=:)) :: T))
+
diff --git a/testsuite/tests/deriving/should_run/T4136.stdout b/testsuite/tests/deriving/should_run/T4136.stdout new file mode 100644 index 0000000000..05a108c942 --- /dev/null +++ b/testsuite/tests/deriving/should_run/T4136.stdout @@ -0,0 +1,2 @@ +show (:=:) = (:=:)
+read (show (:=:)) :: T = (:=:)
diff --git a/testsuite/tests/deriving/should_run/T4528a.hs b/testsuite/tests/deriving/should_run/T4528a.hs new file mode 100644 index 0000000000..85933671c7 --- /dev/null +++ b/testsuite/tests/deriving/should_run/T4528a.hs @@ -0,0 +1,7 @@ +-- Crashed older GHCs when loaded into GHCi + +module Main where + +data T a = A | B | C deriving( Enum, Show ) + +main = print [A ..] diff --git a/testsuite/tests/deriving/should_run/T4528a.stdout b/testsuite/tests/deriving/should_run/T4528a.stdout new file mode 100644 index 0000000000..070375c1da --- /dev/null +++ b/testsuite/tests/deriving/should_run/T4528a.stdout @@ -0,0 +1 @@ +[A,B,C] diff --git a/testsuite/tests/deriving/should_run/T5041.hs b/testsuite/tests/deriving/should_run/T5041.hs new file mode 100644 index 0000000000..4b7ba557dc --- /dev/null +++ b/testsuite/tests/deriving/should_run/T5041.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE MagicHash #-} + +module Main where + +data T = T1# | T2# Int deriving( Read, Show ) + +foo :: [T] +foo = read "[ T1#, T2# 4, T2# 5 ]" +main = print foo + diff --git a/testsuite/tests/deriving/should_run/T5041.stdout b/testsuite/tests/deriving/should_run/T5041.stdout new file mode 100644 index 0000000000..7de0b728af --- /dev/null +++ b/testsuite/tests/deriving/should_run/T5041.stdout @@ -0,0 +1 @@ +[T1#,T2# 4,T2# 5] diff --git a/testsuite/tests/deriving/should_run/all.T b/testsuite/tests/deriving/should_run/all.T new file mode 100644 index 0000000000..83e041f296 --- /dev/null +++ b/testsuite/tests/deriving/should_run/all.T @@ -0,0 +1,34 @@ +# Args to vt are: +# extra compile flags +# extra run flags +# expected process return value, if not zero + +test('drvrun001', skip_if_fast, compile_and_run, ['']) +test('drvrun002', skip_if_fast, compile_and_run, ['']) +test('drvrun003', skip_if_fast, compile_and_run, ['']) +test('drvrun004', skip_if_fast, compile_and_run, ['']) +test('drvrun005', skip_if_fast, compile_and_run, ['']) +test('drvrun006', normal, compile_and_run, ['']) +test('drvrun007', skip_if_fast, compile_and_run, ['']) +test('drvrun008', skip_if_fast, compile_and_run, ['-funbox-strict-fields']) +test('drvrun009', skip_if_fast, compile_and_run, ['']) +test('drvrun010', skip_if_fast, compile_and_run, ['']) +test('drvrun011', skip_if_fast, compile_and_run, ['']) +test('drvrun012', skip_if_fast, compile_and_run, ['']) +test('drvrun013', skip_if_fast, compile_and_run, ['']) +test('drvrun014', skip_if_fast, compile_and_run, ['']) +test('drvrun015', skip_if_fast, compile_and_run, ['']) +test('drvrun016', skip_if_fast, compile_and_run, ['-funbox-strict-fields']) +test('drvrun017', compose(skip_if_fast, only_compiler_types(['ghc'])), compile_and_run, ['']) +test('drvrun018', skip_if_fast, compile_and_run, ['']) +test('drvrun019', normal, compile_and_run, ['']) +test('drvrun020', normal, compile_and_run, ['']) +test('drvrun021', normal, compile_and_run, ['']) +test('drvrun022', reqlib('syb'), compile_and_run, ['-package syb']) +test('T3087', reqlib('syb'), compile_and_run, ['-package syb']) +test('T2529', normal, compile_and_run, ['']) +test('drvrun-functor1', normal, compile_and_run, ['']) +test('drvrun-foldable1', normal, compile_and_run, ['']) +test('T4136', normal, compile_and_run, ['']) +test('T4528a', normal, compile_and_run, ['']) +test('T5041', normal, compile_and_run, ['']) diff --git a/testsuite/tests/deriving/should_run/drvrun-foldable1.hs b/testsuite/tests/deriving/should_run/drvrun-foldable1.hs new file mode 100644 index 0000000000..2db8600389 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun-foldable1.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE DeriveFunctor, DeriveFoldable #-} + +module Main where + +import Prelude hiding (sum) +import Data.Foldable + +-- Derive Foldable for a simple data type + +data List a = Nil | Cons a (List a) + deriving (Functor,Foldable,Show) + +someList = Cons 1 (Cons 1 (Cons 2 (Cons 3 Nil))) + +main = print (sum someList) diff --git a/testsuite/tests/deriving/should_run/drvrun-foldable1.stdout b/testsuite/tests/deriving/should_run/drvrun-foldable1.stdout new file mode 100644 index 0000000000..7f8f011eb7 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun-foldable1.stdout @@ -0,0 +1 @@ +7 diff --git a/testsuite/tests/deriving/should_run/drvrun-functor1.hs b/testsuite/tests/deriving/should_run/drvrun-functor1.hs new file mode 100644 index 0000000000..1367e360e0 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun-functor1.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE DeriveFunctor #-} + +module Main where + +-- Derive functor for a simple data type + +data List a = Nil | Cons a (List a) + deriving (Functor,Show) + +someList = Cons 1 (Cons 1 (Cons 2 (Cons 3 Nil))) +doubleList = fmap (*2) someList + +test1 = do + putStr "normal: " >> print someList + putStr "double: " >> print doubleList + +-- Derive functor for a data type with functions and tuples + +data ReaderWriter r w a = RW { runRW :: r -> (a,w) } + deriving (Functor) + +data Cont r a = Cont { runCont :: (a -> r) -> r } + deriving (Functor) + +test2 = do + let rw = RW (\r -> ("something",r*3)) + putStr "normal: " >> print (runRW rw 123) + putStr "reverse: " >> print (runRW (fmap reverse rw) 456) + let five = Cont ($ 5) + putStr "normal: " >> runCont five print + putStr "double: " >> runCont (fmap (*2) five) print + +-- Derive functor in such a way that we need a constraint + +newtype Compose f g a = Compose (f (g a)) + deriving (Functor,Show) + +listOfLists = Compose [[1,2,3],[7,8,9]] + +test3 = do + putStr "normal: " >> print listOfLists + putStr "double: " >> print (fmap (*2) listOfLists) + +-- All tests + +main = do + test1 + test2 + test3 diff --git a/testsuite/tests/deriving/should_run/drvrun-functor1.stdout b/testsuite/tests/deriving/should_run/drvrun-functor1.stdout new file mode 100644 index 0000000000..ba70f8db7a --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun-functor1.stdout @@ -0,0 +1,8 @@ +normal: Cons 1 (Cons 1 (Cons 2 (Cons 3 Nil))) +double: Cons 2 (Cons 2 (Cons 4 (Cons 6 Nil))) +normal: ("something",369) +reverse: ("gnihtemos",1368) +normal: 5 +double: 10 +normal: Compose [[1,2,3],[7,8,9]] +double: Compose [[2,4,6],[14,16,18]] diff --git a/testsuite/tests/deriving/should_run/drvrun001.hs b/testsuite/tests/deriving/should_run/drvrun001.hs new file mode 100644 index 0000000000..b6bd259aa7 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun001.hs @@ -0,0 +1,13 @@ +-- Test newtype derived instances + +newtype Age = MkAge Int deriving (Eq, Show) + +instance Num Age where + (+) (MkAge a) (MkAge b) = MkAge (a+b) + (*) = undefined + negate = undefined + abs = undefined + signum = undefined + fromInteger = undefined + +main = print (MkAge 3 + MkAge 5) diff --git a/testsuite/tests/deriving/should_run/drvrun001.stdout b/testsuite/tests/deriving/should_run/drvrun001.stdout new file mode 100644 index 0000000000..bbfb2f6226 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun001.stdout @@ -0,0 +1 @@ +MkAge 8 diff --git a/testsuite/tests/deriving/should_run/drvrun002.hs b/testsuite/tests/deriving/should_run/drvrun002.hs new file mode 100644 index 0000000000..26497bd32c --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun002.hs @@ -0,0 +1,17 @@ +-- !!! Deriving Show/Read for type with labelled fields. +-- (based on a Hugs bug report.) +module Main(main) where + +data Options = + Options { s :: OptionKind } + deriving (Show, Read) + +data OptionKind = + SpecialOptions { test :: Int } + deriving (Show, Read) + +x = Options{s=SpecialOptions{test=42}} + +main = do + print x + print ((read (show x))::Options) diff --git a/testsuite/tests/deriving/should_run/drvrun002.stdout b/testsuite/tests/deriving/should_run/drvrun002.stdout new file mode 100644 index 0000000000..00c70df868 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun002.stdout @@ -0,0 +1,2 @@ +Options {s = SpecialOptions {test = 42}} +Options {s = SpecialOptions {test = 42}} diff --git a/testsuite/tests/deriving/should_run/drvrun003.hs b/testsuite/tests/deriving/should_run/drvrun003.hs new file mode 100644 index 0000000000..bb7486159e --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun003.hs @@ -0,0 +1,30 @@ +-- !!! Deriving Show/Read for nullary constructors. +module Main(main) where + +data A = B | C deriving ( Show, Read ) + +data Opt = N | Y A deriving (Show, Read) + +x = Y B + +{- + If the Haskell report's specification of how Show instances + are to be derived is followed to the letter, the code for + a nullary constructor would put parens around the constructor + when (showsPrec 10) is used. This would cause + + Y A + + to be showed as + + Y (A) + + Overkill, so ghc's derived Show code treats nullary + constructors specially. +-} + +main = do + print x + print ((read (show x))::Opt) + print ((read "Y (B)")::Opt) + diff --git a/testsuite/tests/deriving/should_run/drvrun003.stdout b/testsuite/tests/deriving/should_run/drvrun003.stdout new file mode 100644 index 0000000000..584cfcd5ce --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun003.stdout @@ -0,0 +1,3 @@ +Y B +Y B +Y B diff --git a/testsuite/tests/deriving/should_run/drvrun004.hs b/testsuite/tests/deriving/should_run/drvrun004.hs new file mode 100644 index 0000000000..f530803835 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun004.hs @@ -0,0 +1,10 @@ +module Main where + +data Hash = Hash{ (#) :: Int } + deriving (Show, Read) + +main = + do print s + print (read s :: Hash) + where + s = show (Hash 3) diff --git a/testsuite/tests/deriving/should_run/drvrun004.stdout b/testsuite/tests/deriving/should_run/drvrun004.stdout new file mode 100644 index 0000000000..c9088b7bd6 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun004.stdout @@ -0,0 +1,2 @@ +"Hash {(#) = 3}" +Hash {(#) = 3} diff --git a/testsuite/tests/deriving/should_run/drvrun005.hs b/testsuite/tests/deriving/should_run/drvrun005.hs new file mode 100644 index 0000000000..a4ef060a6a --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun005.hs @@ -0,0 +1,27 @@ +module Main where + +{- + If a fixity declaration hasn't been supplied for + an operator, it is defaulted to being "infixl 9". + + OLD: The derived Read instances for data types containing + left-assoc constructors produces code that causes + non-termination if you use 'read' to evaluate them + ( (head (reads x)) is cool tho.) + + ==> The inferred assoc for :++ below left & the derived + Read instance should fail to terminate (with ghc-4.xx, + this is exemplified by having the stack overflow.) + + NEW: the new H98 spec says that we ignore associativity when + parsing, so it terminates fine +-} +-- infixl 9 :++ +data T = T1 | T :++ T deriving (Eq,Show, Read) + +t :: T +t = read "T1" + +main = do + print ((fst (head (reads "T1"))) :: T) + print t diff --git a/testsuite/tests/deriving/should_run/drvrun005.stderr b/testsuite/tests/deriving/should_run/drvrun005.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun005.stderr diff --git a/testsuite/tests/deriving/should_run/drvrun005.stdout b/testsuite/tests/deriving/should_run/drvrun005.stdout new file mode 100644 index 0000000000..c90bc69dcd --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun005.stdout @@ -0,0 +1,2 @@ +T1 +T1 diff --git a/testsuite/tests/deriving/should_run/drvrun006.hs b/testsuite/tests/deriving/should_run/drvrun006.hs new file mode 100644 index 0000000000..3d268019bd --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun006.hs @@ -0,0 +1,49 @@ +-- !!! Show/Read deriving example given in the Haskell Report. +module Main(main) where + +infix 4 :^: +data Tree a + = Leaf a | (Tree a) :^: (Tree a) + deriving (Show, Read) + +val1 :: Tree Int +val1 = Leaf 2 + +val2 :: Tree Int +val2 = Leaf 2 :^: Leaf (-1) + +main = do + print val1 + print val2 + + print ((read (show val1))::Tree Int) + print ((read (show val2))::Tree Int) + print ((read (show val1))::Tree Integer) + print ((read (show val2))::Tree Integer) + +{- What you'll want +instance (Show a) => Show (Tree a) where + + showsPrec d (Leaf m) = showParen (d >= 10) showStr + where + showStr = showString "Leaf " . showsPrec 10 m + + showsPrec d (u :^: v) = showParen (d > 4) showStr + where + showStr = showsPrec 5 u . + showString " :^: " . + showsPrec 5 v + +instance (Read a) => Read (Tree a) where + + readsPrec d r = readParen (d > 4) + (\r -> [(u:^:v,w) | + (u,s) <- readsPrec 5 r, + (":^:",t) <- lex s, + (v,w) <- readsPrec 5 t]) r + + ++ readParen (d > 9) + (\r -> [(Leaf m,t) | + ("Leaf",s) <- lex r, + (m,t) <- readsPrec 10 s]) r +-} diff --git a/testsuite/tests/deriving/should_run/drvrun006.stdout b/testsuite/tests/deriving/should_run/drvrun006.stdout new file mode 100644 index 0000000000..fe1beeeae0 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun006.stdout @@ -0,0 +1,6 @@ +Leaf 2 +Leaf 2 :^: Leaf (-1) +Leaf 2 +Leaf 2 :^: Leaf (-1) +Leaf 2 +Leaf 2 :^: Leaf (-1) diff --git a/testsuite/tests/deriving/should_run/drvrun007.hs b/testsuite/tests/deriving/should_run/drvrun007.hs new file mode 100644 index 0000000000..5c26c3448d --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun007.hs @@ -0,0 +1,6 @@ +module Main( main ) where +-- This one crashed Hugs98 + +data X = X | X :\ X deriving Show + +main = putStrLn (show (X :\ X)) diff --git a/testsuite/tests/deriving/should_run/drvrun007.stdout b/testsuite/tests/deriving/should_run/drvrun007.stdout new file mode 100644 index 0000000000..fe13f39338 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun007.stdout @@ -0,0 +1 @@ +X :\ X diff --git a/testsuite/tests/deriving/should_run/drvrun008.hs b/testsuite/tests/deriving/should_run/drvrun008.hs new file mode 100644 index 0000000000..7fe77992ed --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun008.hs @@ -0,0 +1,8 @@ +-- !!! Check that -funbox-strict-fields doesn't mess up deriving (can't be in an options pragma, it's in the Makefile) +-- !!! (it did in 4.04) + +module Main( main ) where + +data X = X !Int deriving Eq + +main = putStrLn (show (X 2 == X 2)) diff --git a/testsuite/tests/deriving/should_run/drvrun008.stdout b/testsuite/tests/deriving/should_run/drvrun008.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun008.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/deriving/should_run/drvrun009.hs b/testsuite/tests/deriving/should_run/drvrun009.hs new file mode 100644 index 0000000000..0bd22ab787 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun009.hs @@ -0,0 +1,20 @@ +-- !!! Check the Read instance for Array +-- [Not strictly a 'deriving' issue] + +module Main( main ) where +import Data.Array + +bds :: ((Int,Int),(Int,Int)) +bds = ((1,4),(2,5)) + +type MyArr = Array (Int,Int) Int + +a :: MyArr +a = array bds [ ((i,j), i+j) | (i,j) <- range bds ] + +main = do { putStrLn (show a) ; + let { b :: MyArr ; + b = read (show a) } ; + putStrLn (show b) + } + diff --git a/testsuite/tests/deriving/should_run/drvrun009.stdout b/testsuite/tests/deriving/should_run/drvrun009.stdout new file mode 100644 index 0000000000..2a7d99bd37 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun009.stdout @@ -0,0 +1,2 @@ +array ((1,4),(2,5)) [((1,4),5),((1,5),6),((2,4),6),((2,5),7)] +array ((1,4),(2,5)) [((1,4),5),((1,5),6),((2,4),6),((2,5),7)] diff --git a/testsuite/tests/deriving/should_run/drvrun010.hs b/testsuite/tests/deriving/should_run/drvrun010.hs new file mode 100644 index 0000000000..0a2f3d2742 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun010.hs @@ -0,0 +1,12 @@ +module Main where + +data Test = Test { field :: Int } deriving (Eq,Show,Read) + +main = putStrLn $ + if read (show (Test {field=(-1)})) == Test (-1) + then "works" else "not" + +-- The point here is that if 'show' generates +-- Test { field=-1 } +-- the lexer things the '=-' is one lexeme, which does not work + diff --git a/testsuite/tests/deriving/should_run/drvrun010.stdout b/testsuite/tests/deriving/should_run/drvrun010.stdout new file mode 100644 index 0000000000..153d19401b --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun010.stdout @@ -0,0 +1 @@ +works diff --git a/testsuite/tests/deriving/should_run/drvrun011.hs b/testsuite/tests/deriving/should_run/drvrun011.hs new file mode 100644 index 0000000000..aad1482f2a --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun011.hs @@ -0,0 +1,16 @@ +-- Tests some simple deriving stuff, and built-in instances + +module Main( main ) where + +data Command = Commit (Maybe String) | Foo | Baz Bool | Boz Int + deriving (Read,Show) + +type T = ([Command], [Command], [Command]) +val :: T +val = ([Commit Nothing, Commit (Just "foo")], + [Foo, Baz True], + [Boz 3, Boz (-2)]) + +main = do { print val ; + print ((read (show val)) :: T) } + diff --git a/testsuite/tests/deriving/should_run/drvrun011.stdout b/testsuite/tests/deriving/should_run/drvrun011.stdout new file mode 100644 index 0000000000..0ddc486aad --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun011.stdout @@ -0,0 +1,2 @@ +([Commit Nothing,Commit (Just "foo")],[Foo,Baz True],[Boz 3,Boz (-2)]) +([Commit Nothing,Commit (Just "foo")],[Foo,Baz True],[Boz 3,Boz (-2)]) diff --git a/testsuite/tests/deriving/should_run/drvrun012.hs b/testsuite/tests/deriving/should_run/drvrun012.hs new file mode 100644 index 0000000000..3775a3b958 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun012.hs @@ -0,0 +1,11 @@ +-- Tests readings of record syntax + +module Main where + +data Foo = Foo { x :: Baz, y :: Maybe Int } deriving (Read,Show) + +infix 0 :%% +data Baz = Int :%% Int deriving( Read,Show) + + +main = print (read "Foo { x = 1 :%% 2, y = Just 4 }" :: Foo) diff --git a/testsuite/tests/deriving/should_run/drvrun012.stdout b/testsuite/tests/deriving/should_run/drvrun012.stdout new file mode 100644 index 0000000000..dbef9bc870 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun012.stdout @@ -0,0 +1 @@ +Foo {x = 1 :%% 2, y = Just 4} diff --git a/testsuite/tests/deriving/should_run/drvrun013.hs b/testsuite/tests/deriving/should_run/drvrun013.hs new file mode 100644 index 0000000000..2a9adae585 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun013.hs @@ -0,0 +1,19 @@ +-- This test makes sure that the derivied instance for +-- Eq A +-- "sees" the non-derived instance for +-- Eq B +-- +-- In a version of GHC 5.05, this didn't happen, because the +-- deriving mechanism looked through A's rep-type and found Int + +module Main where + +newtype B = MkB Int +instance Eq B where + (MkB 1) == (MkB 2) = True -- Non-standard equality + (MkB a) == (MkB b) = False + +newtype A = MkA B deriving( Eq ) + +main = print (MkA (MkB 1) == MkA (MkB 2)) +-- Should say "True", because of B's non-standard instance diff --git a/testsuite/tests/deriving/should_run/drvrun013.stdout b/testsuite/tests/deriving/should_run/drvrun013.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun013.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/deriving/should_run/drvrun014.hs b/testsuite/tests/deriving/should_run/drvrun014.hs new file mode 100644 index 0000000000..806af8ce1c --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun014.hs @@ -0,0 +1,19 @@ +-- This one gave the wrong answer with ghci 5.02.3 (and 5.02.2) + +module Main where + +infixr 3 :* +infixr 2 :+ + +data RE a = RE a :+ RE a + | RE a :* RE a + | Cat [RE a] + | Star (RE a) + | Plus (RE a) + | Opt (RE a) + | Comp (RE a) + | Empty + | Str [a] + deriving (Show, Eq, Ord) + +main = print (Str "ab" == (Str "a" :+ Str "b")) diff --git a/testsuite/tests/deriving/should_run/drvrun014.stdout b/testsuite/tests/deriving/should_run/drvrun014.stdout new file mode 100644 index 0000000000..bc59c12aa1 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun014.stdout @@ -0,0 +1 @@ +False diff --git a/testsuite/tests/deriving/should_run/drvrun015.hs b/testsuite/tests/deriving/should_run/drvrun015.hs new file mode 100644 index 0000000000..b6e10394fa --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun015.hs @@ -0,0 +1,8 @@ +-- The leading underscore killed GHC 5.04 + +module Main where + +data Obj = Obj {_id, p1, p2::Int} deriving (Show, Read) + + +main = print (show (read "Obj {_id=1,p1=10,p2=20}" :: Obj)) diff --git a/testsuite/tests/deriving/should_run/drvrun015.stdout b/testsuite/tests/deriving/should_run/drvrun015.stdout new file mode 100644 index 0000000000..d7059cd3ff --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun015.stdout @@ -0,0 +1 @@ +"Obj {_id = 1, p1 = 10, p2 = 20}" diff --git a/testsuite/tests/deriving/should_run/drvrun016.hs b/testsuite/tests/deriving/should_run/drvrun016.hs new file mode 100644 index 0000000000..1d6de577ac --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun016.hs @@ -0,0 +1,18 @@ +-- Run with -funbox-strict-fields +-- Bug in GHC 5.04.3 + +module Main where + +data Foo = Foo Int String +data Bar = Bar Int Foo + +instance Ord Bar where + compare (Bar i _) (Bar j _) = compare i j + +instance Eq Bar where + (Bar i _) == (Bar j _) = i == j + + +data Zot = Zot !Bar !String deriving (Ord,Eq) + +main = putStrLn "Success" diff --git a/testsuite/tests/deriving/should_run/drvrun016.stdout b/testsuite/tests/deriving/should_run/drvrun016.stdout new file mode 100644 index 0000000000..35821117c8 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun016.stdout @@ -0,0 +1 @@ +Success diff --git a/testsuite/tests/deriving/should_run/drvrun017.hs b/testsuite/tests/deriving/should_run/drvrun017.hs new file mode 100644 index 0000000000..e14619c1a9 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun017.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE MagicHash #-} + +-- Test Show on unboxed types + +module Main where +import GHC.Base + +data Foo = MkFoo Int# Float# Int deriving( Show ) + +main = print (MkFoo 3# 4.3# 2)
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_run/drvrun017.stdout b/testsuite/tests/deriving/should_run/drvrun017.stdout new file mode 100644 index 0000000000..6f1bd8c7fa --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun017.stdout @@ -0,0 +1 @@ +MkFoo 3 4.3 2 diff --git a/testsuite/tests/deriving/should_run/drvrun018.hs b/testsuite/tests/deriving/should_run/drvrun018.hs new file mode 100644 index 0000000000..a0b9f24362 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun018.hs @@ -0,0 +1,9 @@ + +-- Test Show on unboxed types + +module Main where + +data Foo = Int `MkFoo` Int deriving( Read, Show ) + +main = do { print (MkFoo 4 5) + ; print (read "3 `MkFoo` 5" :: Foo) } diff --git a/testsuite/tests/deriving/should_run/drvrun018.stdout b/testsuite/tests/deriving/should_run/drvrun018.stdout new file mode 100644 index 0000000000..5393fc4654 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun018.stdout @@ -0,0 +1,2 @@ +4 `MkFoo` 5 +3 `MkFoo` 5 diff --git a/testsuite/tests/deriving/should_run/drvrun019.hs b/testsuite/tests/deriving/should_run/drvrun019.hs new file mode 100644 index 0000000000..3fd8ccf025 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun019.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +
+-- Tests newtype deriving with
+-- a non-type constructor in the representation
+
+module Main where
+
+newtype Wrap m a = Wrap { unWrap :: m a }
+ deriving (Monad, Eq)
+
+foo :: Int -> Wrap IO a -> Wrap IO ()
+foo 0 a = return ()
+foo n a = do { a; foo (n-1) a }
+
+main = do { unWrap (foo 3 (Wrap (putChar 'x'))); putChar '\n' }
diff --git a/testsuite/tests/deriving/should_run/drvrun019.stdout b/testsuite/tests/deriving/should_run/drvrun019.stdout new file mode 100644 index 0000000000..f165e2102f --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun019.stdout @@ -0,0 +1 @@ +xxx
diff --git a/testsuite/tests/deriving/should_run/drvrun020.hs b/testsuite/tests/deriving/should_run/drvrun020.hs new file mode 100644 index 0000000000..cf78a2a992 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun020.hs @@ -0,0 +1,46 @@ +-- A nasty deriving test +-- Note the "T2 T1 { f1=3 }" part! + +module Main where + + +infix 4 :%% +data T = Int :%% T + | T1 { f1 :: Int } + | T2 T + deriving( Show, Read ) + +main = print (read "3 :%% T2 T1 { f1=3 }" :: T) + +{- Here's the parser that is produced + +import GHC.Read +import Text.ParserCombinators.ReadPrec +import Text.Read + +instance Read T where + readPrec = + parens + ( prec 4 ( + do x <- step readPrec + Symbol ":%%" <- lexP + y <- step readPrec + return (x :%% y)) + +++ + prec (appPrec+1) ( + do Ident "T1" <- lexP + Punc "{" <- lexP + Ident "f1" <- lexP + Punc "=" <- lexP + x <- reset readPrec + Punc "}" <- lexP + return (T1 { f1 = x })) + +++ + prec appPrec ( + do Ident "T2" <- lexP + x <- step readPrec + return (T2 x)) + ) + +appPrec = 10::Int +-} diff --git a/testsuite/tests/deriving/should_run/drvrun020.stdout b/testsuite/tests/deriving/should_run/drvrun020.stdout new file mode 100644 index 0000000000..bb33aca722 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun020.stdout @@ -0,0 +1 @@ +3 :%% T2 (T1 {f1 = 3}) diff --git a/testsuite/tests/deriving/should_run/drvrun021.hs b/testsuite/tests/deriving/should_run/drvrun021.hs new file mode 100644 index 0000000000..05c7c8dbf0 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun021.hs @@ -0,0 +1,20 @@ +module Main where + +class Show a => Foo a where + op :: a -> a + +newtype Moose = MkMoose () deriving (Show, Eq, Ord) + +newtype Noose = MkNoose () deriving (Ord) + +instance Eq Noose where + a == b = False -- Non-standard! + +f :: Ord a => a -> Bool +f x = x==x + +main = do print (MkNoose () == MkNoose ()) -- Eq Noose + print (f (MkNoose ())) -- via Ord Noose + print (MkMoose () == MkMoose ()) -- Eq Moose + print (f (MkMoose ())) -- via Ord Moose + putStrLn (show (MkMoose ())) -- Should not use the show () method diff --git a/testsuite/tests/deriving/should_run/drvrun021.stdout b/testsuite/tests/deriving/should_run/drvrun021.stdout new file mode 100644 index 0000000000..ae2b8d6354 --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun021.stdout @@ -0,0 +1,5 @@ +False +False +True +True +MkMoose () diff --git a/testsuite/tests/deriving/should_run/drvrun022.hs b/testsuite/tests/deriving/should_run/drvrun022.hs new file mode 100644 index 0000000000..fe95c3323b --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun022.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +module Main where + +-- GHC 6.4.1 output "testz" in z-encoded form! + +import Data.Generics + +data TestZ = TestZ { testz :: Int } + deriving (Show, Read, Eq, Data, Typeable) + +main = print $ constrFields . toConstr $ TestZ { testz = 2 } diff --git a/testsuite/tests/deriving/should_run/drvrun022.stdout b/testsuite/tests/deriving/should_run/drvrun022.stdout new file mode 100644 index 0000000000..e0ea368f1a --- /dev/null +++ b/testsuite/tests/deriving/should_run/drvrun022.stdout @@ -0,0 +1 @@ +["testz"] |