diff options
| author | David Terei <davidterei@gmail.com> | 2011-07-20 11:09:03 -0700 |
|---|---|---|
| committer | David Terei <davidterei@gmail.com> | 2011-07-20 11:26:35 -0700 |
| commit | 16514f272fb42af6e9c7674a9bd6c9dce369231f (patch) | |
| tree | e4f332b45fe65e2a7a2451be5674f887b42bf199 /testsuite/tests/deriving | |
| parent | ebd422aed41048476aa61dd4c520d43becd78682 (diff) | |
| download | haskell-16514f272fb42af6e9c7674a9bd6c9dce369231f.tar.gz | |
Move tests from tests/ghc-regress/* to just tests/*
Diffstat (limited to 'testsuite/tests/deriving')
179 files changed, 1934 insertions, 0 deletions
diff --git a/testsuite/tests/deriving/Makefile b/testsuite/tests/deriving/Makefile new file mode 100644 index 0000000000..9a36a1c5fe --- /dev/null +++ b/testsuite/tests/deriving/Makefile @@ -0,0 +1,3 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/deriving/should_compile/Makefile b/testsuite/tests/deriving/should_compile/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/deriving/should_compile/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/deriving/should_compile/T2378.hs b/testsuite/tests/deriving/should_compile/T2378.hs new file mode 100644 index 0000000000..e3118cb863 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T2378.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} +module Foo( T ) where + +-- Trac 2378 + +import Data.Data + +newtype T f = MkT Int + +deriving instance Typeable1 T diff --git a/testsuite/tests/deriving/should_compile/T2856.hs b/testsuite/tests/deriving/should_compile/T2856.hs new file mode 100644 index 0000000000..c8f81a00bc --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T2856.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleInstances #-} + +-- Test Trac #2856 + +module T2856 where + +import Data.Ratio + +---------------------- +class C a where + data D a + +instance C Bool where + newtype D Bool = DInt Int deriving (Eq, Show, Num) + +instance C a => C [a] where + newtype D [a] = DList (Ratio a) deriving (Eq, Show, Num) + +---------------------- +data family W a +newtype instance W Bool = WInt Int deriving( Eq, Show ) +newtype instance W [a] = WList (Ratio a) deriving( Eq, Show ) + +deriving instance Num (W Bool) +deriving instance (Integral a, Num a) => Num (W [a]) + -- Integral needed because superclass Eq needs it, + -- because of the stupid context on Ratio + diff --git a/testsuite/tests/deriving/should_compile/T3012.hs b/testsuite/tests/deriving/should_compile/T3012.hs new file mode 100644 index 0000000000..44b1d64a9c --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T3012.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE GADTs, StandaloneDeriving #-}
+
+module T3012 where
+
+data T a where
+ Foo :: T Int
+ Bar :: T Bool
+
+deriving instance Show (T a)
+
diff --git a/testsuite/tests/deriving/should_compile/T3057.hs b/testsuite/tests/deriving/should_compile/T3057.hs new file mode 100644 index 0000000000..0e9aef7814 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T3057.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE StandaloneDeriving, DeriveFunctor #-} +module T3057 where + +deriving instance Functor (Either a) + + diff --git a/testsuite/tests/deriving/should_compile/T3965.hs b/testsuite/tests/deriving/should_compile/T3965.hs new file mode 100644 index 0000000000..2ccaaadfdf --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T3965.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, StandaloneDeriving, TypeOperators, UndecidableInstances #-} +module T3965 where + +import Data.Data + +data T f e = Inl (f e) deriving (Data, Eq) + +instance (Typeable1 f) => Typeable1 (T f) where + typeOf1 _ = error "urk" + +newtype Expr f = In (f (Expr f)) +instance Typeable1 f => Typeable (Expr f) where + typeOf _ = error "urk" + +deriving instance (Typeable1 a, Data (a (Expr a))) => Data (Expr a) + +data Var e = Var String deriving (Data, Eq, Typeable) + +data Domain e g = Domain + (Expr (T Var)) + deriving (Data, Typeable) + + diff --git a/testsuite/tests/deriving/should_compile/T4220.hs b/testsuite/tests/deriving/should_compile/T4220.hs new file mode 100644 index 0000000000..0b2ba28caa --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T4220.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE EmptyDataDecls, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} +module T4220 where + +import Data.Foldable +import Data.Traversable + +data Void a deriving (Functor, Foldable, Traversable) diff --git a/testsuite/tests/deriving/should_compile/T4302.hs b/testsuite/tests/deriving/should_compile/T4302.hs new file mode 100644 index 0000000000..50369632f9 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T4302.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, EmptyDataDecls #-} +module T4302 where + +import Data.Ix +import Data.Typeable +import Data.Data +import Data.Foldable +import Data.Traversable + +data Test a + +deriving instance Eq (Test a) +deriving instance Ord (Test a) +deriving instance Typeable1 Test +deriving instance Data a => Data (Test a) +deriving instance Functor Test +deriving instance Foldable Test +deriving instance Traversable Test diff --git a/testsuite/tests/deriving/should_compile/T4325.hs b/testsuite/tests/deriving/should_compile/T4325.hs new file mode 100644 index 0000000000..68ab81744b --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T4325.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE DatatypeContexts #-} + +module T4325 where + +data Ord a => Heap a b = Empty | Node a b [Heap a b] + deriving Eq + diff --git a/testsuite/tests/deriving/should_compile/T4325.stderr b/testsuite/tests/deriving/should_compile/T4325.stderr new file mode 100644 index 0000000000..90ef1de92d --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T4325.stderr @@ -0,0 +1,3 @@ + +T4325.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/deriving/should_compile/T4816.hs b/testsuite/tests/deriving/should_compile/T4816.hs new file mode 100644 index 0000000000..0e81e39521 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T4816.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE DeriveFunctor #-} + +module T4816 where + +data Silly a = Sillly a + +data Baz o = Baz { + foo :: o, + bar :: Silly () + } deriving (Functor) diff --git a/testsuite/tests/deriving/should_compile/T4966.hs b/testsuite/tests/deriving/should_compile/T4966.hs new file mode 100644 index 0000000000..d7328c6ef6 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T4966.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE DatatypeContexts #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE OverlappingInstances #-} + +module HTk.Toolkit.TreeList (getObjectFromTreeList) where + +class Eq c => CItem c + +-- A bizarre instance decl! +-- People who use instance decls like this are asking for trouble +instance GUIObject w => Eq w where + w1 == w2 = toGUIObject w1 == toGUIObject w2 + +data StateEntry a + = StateEntry (TreeListObject a) a -- Comment this 'a' out and it type checks + deriving Eq + +-- The delicate point about this test is that we want to +-- infer a derived instance decl like this: +-- instance (CItem a, Eq a) => Eq (StateEntry a) +-- But note the instance decl for (Eq w) for any w! +-- There's a danger than we'll use that instance decl +-- to get the derived instance +-- instance (CItem a, GUIObject a) => Eq (StateEntry a) +-- And then that doesn't work subsequently + +getObjectFromTreeList :: CItem a => StateEntry a -> Bool +getObjectFromTreeList state = state == state + +data CItem a => TreeListObject a + +instance CItem a => Eq (TreeListObject a) + +class GUIObject w where + toGUIObject :: w -> GUIOBJECT + + +data GUIOBJECT + +instance Eq GUIOBJECT where + (==) = undefined + (/=) = undefined diff --git a/testsuite/tests/deriving/should_compile/T4966.stderr b/testsuite/tests/deriving/should_compile/T4966.stderr new file mode 100644 index 0000000000..b8059925bb --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T4966.stderr @@ -0,0 +1,3 @@ + +T4966.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/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T new file mode 100644 index 0000000000..22353ab2ea --- /dev/null +++ b/testsuite/tests/deriving/should_compile/all.T @@ -0,0 +1,32 @@ +test('drv001', normal, compile, ['']) +test('drv002', normal, compile, ['']) +test('drv003', normal, compile, ['']) +test('drv004', normal, compile, ['']) +test('drv005', normal, compile, ['']) +test('drv006', normal, compile, ['']) +test('drv007', normal, compile, ['']) +test('drv008', normal, compile, ['']) +test('drv009', normal, compile, ['']) +test('drv010', normal, compile, ['']) +test('drv011', normal, compile, ['']) +test('drv012', normal, compile, ['']) +test('drv013', normal, compile, ['']) +test('drv014', normal, compile, ['']) +test('drv015', normal, compile, ['']) +test('drv020', normal, compile, ['']) +test('drv021', normal, compile, ['']) +test('deriving-1935', normal, compile, ['']) +test('T2378', normal, compile, ['']) +test('T2856', normal, compile, ['']) +test('T3057', normal, compile, ['']) +test('T3012', normal, compile, ['']) +test('T3965', normal, compile, ['']) +test('T4220', normal, compile, ['']) +test('T4302', normal, compile, ['']) +test('T4325', normal, compile, ['']) +test('T4816', normal, compile, ['']) +test('T4966', normal, compile, ['']) + +test('drv-functor1', normal, compile, ['']) +test('drv-functor2', normal, compile, ['']) +test('drv-foldable-traversable1', normal, compile, ['']) diff --git a/testsuite/tests/deriving/should_compile/deriving-1935.hs b/testsuite/tests/deriving/should_compile/deriving-1935.hs new file mode 100644 index 0000000000..5b3bca0c77 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/deriving-1935.hs @@ -0,0 +1,22 @@ +{-# OPTIONS_GHC -XDeriveDataTypeable #-} + +-- Trac #1935 +-- See Note [Superclasses of derived instance] in TcDeriv + +module Foo where + + import Data.Data + + data Foo a = Foo + deriving (Data, Typeable) + + data T a = MkT (S a) deriving( Ord ) + + instance Num a => Eq (T a) + + data S a = S + instance Eq (S a) + instance Ord (S a) + + +
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_compile/drv-foldable-traversable1.hs b/testsuite/tests/deriving/should_compile/drv-foldable-traversable1.hs new file mode 100644 index 0000000000..712f14a3b5 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv-foldable-traversable1.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE FlexibleContexts, DatatypeContexts #-} + +module ShouldCompile where + +import Data.Foldable +import Data.Traversable + +data Trivial a = Trivial + deriving (Functor,Foldable,Traversable) + +-- lots of different things +data Strange a b c + = T1 a b c + | T2 c c c + | T3 [a] [b] [c] -- lists + | T4 [[a]] [[b]] [[c]] -- nested lists + | T5 (c,(b,b),(c,c)) -- tuples + | T6 ([c],Strange a b c) -- tycons + deriving (Functor,Foldable,Traversable) + +data NotPrimitivelyRecursive a + = S1 (NotPrimitivelyRecursive (a,a)) + | S2 a + deriving (Functor,Foldable,Traversable) + +data Eq a => StupidConstraint a b = Stupid a b + deriving (Functor,Foldable,Traversable) + +-- requires Foldable/Traversable constraint on f and g +data Compose f g a = Compose (f (g a)) + deriving (Functor,Foldable,Traversable) diff --git a/testsuite/tests/deriving/should_compile/drv-foldable-traversable1.stderr b/testsuite/tests/deriving/should_compile/drv-foldable-traversable1.stderr new file mode 100644 index 0000000000..ceae10cabd --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv-foldable-traversable1.stderr @@ -0,0 +1,3 @@ + +drv-foldable-traversable1.hs:3:32: + Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. diff --git a/testsuite/tests/deriving/should_compile/drv-functor1.hs b/testsuite/tests/deriving/should_compile/drv-functor1.hs new file mode 100644 index 0000000000..8249858cae --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv-functor1.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DatatypeContexts #-} + +module ShouldCompile where + +data Trivial a = Trivial + deriving (Functor) + +data Fun a = Fun (Int -> a) + deriving (Functor) + +-- lots of different things +data Strange a b c + = T1 a b c + | T2 [a] [b] [c] -- lists + | T3 [[a]] [[b]] [[c]] -- nested lists + | T4 (c,(b,b),(c,c)) -- tuples + | T5 ([c],Strange a b c) -- tycons + | T6 (Int -> c) -- function types + | T7 (a -> (c,a)) -- functions and tuples + | T8 ((c -> a) -> a) -- continuation + deriving (Functor) + +data NotPrimitivelyRecursive a + = S1 (NotPrimitivelyRecursive (a,a)) + | S2 a + deriving (Functor,Eq) + +data Eq a => StupidConstraint a b = Stupid a b + deriving (Functor) + +-- requires Functor constraint on f and g +data Compose f g a = Compose (f (g a)) + deriving (Functor) + +-- We can't derive Functor for the following type. +-- it needs both (Functor (f Int)) and (Functor (f Bool)) +-- i.e.: +-- instance (Functor (f Bool), Functor (f Int)) => Functor (ComplexConstraint f) +-- This requires FlexibleContexts and UndecidableInstances +data ComplexConstraint f a = ComplexContraint (f Int (f Bool a,a)) +-- deriving (Functor) + +data Universal a + = Universal (forall b. (b,[a])) + | Universal2 (forall f. Functor f => (f a)) + | Universal3 (forall a. a -> Int) -- reuse a + | NotReallyUniversal (forall b. a) + deriving (Functor) + +-- Ghc doesn't allow deriving for non-Haskell98 data constructors +data Existential b + = forall a. ExistentialList [a] + | forall f. Functor f => ExistentialFunctor (f b) + | forall b. SneakyUseSameName (b -> Bool) + -- deriving (Functor) + +-- Don't get confused by synonyms +type IntFun a = Int -> a +data IntFunD a = IntFunD (IntFun a) + deriving (Functor) + diff --git a/testsuite/tests/deriving/should_compile/drv-functor1.stderr b/testsuite/tests/deriving/should_compile/drv-functor1.stderr new file mode 100644 index 0000000000..a531dc56ef --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv-functor1.stderr @@ -0,0 +1,3 @@ + +drv-functor1.hs:5:14: + Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. diff --git a/testsuite/tests/deriving/should_compile/drv-functor2.hs b/testsuite/tests/deriving/should_compile/drv-functor2.hs new file mode 100644 index 0000000000..d070feb06d --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv-functor2.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module ShouldCompile where + +-- Deriving Functor should still work with GeneralizedNewtypeDeriving instead of DeriveFunctor + +newtype List a = List [a] + deriving (Functor) + diff --git a/testsuite/tests/deriving/should_compile/drv001.hs b/testsuite/tests/deriving/should_compile/drv001.hs new file mode 100644 index 0000000000..694af6a50f --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv001.hs @@ -0,0 +1,21 @@ +-- !!! canonical weird example for "deriving" +module ShouldSucceed where + +data X a b + = C1 (T a) + | C2 (Y b) + | C3 (X b a) + deriving (Read, Show) + +data Y b + = D1 + | D2 (X Int b) + deriving (Read, Show) + +data T a + = E1 + +instance Eq a => Show (T a) where + showsPrec = error "show" +instance Eq a => Read (T a) where + readsPrec = error "read" diff --git a/testsuite/tests/deriving/should_compile/drv001.stderr b/testsuite/tests/deriving/should_compile/drv001.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv001.stderr diff --git a/testsuite/tests/deriving/should_compile/drv002.hs b/testsuite/tests/deriving/should_compile/drv002.hs new file mode 100644 index 0000000000..15eb2d9ecc --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv002.hs @@ -0,0 +1,14 @@ +module ShouldSucceed where + +data Z a b + = C1 (T a) + | C2 (Z [a] [b]) + deriving (Show, Read) + +data T a + = E1 + +instance Eq a => Show (T a) where + showsPrec = error "show" +instance Eq a => Read (T a) where + readsPrec = error "read" diff --git a/testsuite/tests/deriving/should_compile/drv002.stderr b/testsuite/tests/deriving/should_compile/drv002.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv002.stderr diff --git a/testsuite/tests/deriving/should_compile/drv003.hs b/testsuite/tests/deriving/should_compile/drv003.hs new file mode 100644 index 0000000000..0b8149ce8a --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv003.hs @@ -0,0 +1,17 @@ +-- !!! This is the example given in TcDeriv +-- +module ShouldSucceed where + +data T a b + = C1 (Foo a) (Bar b) + | C2 Int (T b a) + | C3 (T a a) + deriving Eq + +data Foo a = MkFoo Double a deriving () +instance (Eq a) => Eq (Foo a) + +data Bar a = MkBar Int Int deriving () +instance (Ping b) => Eq (Bar b) + +class Ping a diff --git a/testsuite/tests/deriving/should_compile/drv003.stderr b/testsuite/tests/deriving/should_compile/drv003.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv003.stderr diff --git a/testsuite/tests/deriving/should_compile/drv004.hs b/testsuite/tests/deriving/should_compile/drv004.hs new file mode 100644 index 0000000000..324a7f81d4 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv004.hs @@ -0,0 +1,9 @@ +-- !!! simple example of deriving Ord and Eq simultaneously +-- +module ShouldSucceed where + +data Foo a b c + = C1 a Int + | C2 b Double + | C3 c String + deriving (Eq, Ord) diff --git a/testsuite/tests/deriving/should_compile/drv004.stderr b/testsuite/tests/deriving/should_compile/drv004.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv004.stderr diff --git a/testsuite/tests/deriving/should_compile/drv005.hs b/testsuite/tests/deriving/should_compile/drv005.hs new file mode 100644 index 0000000000..527dde98b9 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv005.hs @@ -0,0 +1,6 @@ +-- !!! simple example of deriving Enum +-- +module ShouldSucceed where + +data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8 + deriving Enum diff --git a/testsuite/tests/deriving/should_compile/drv005.stderr b/testsuite/tests/deriving/should_compile/drv005.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv005.stderr diff --git a/testsuite/tests/deriving/should_compile/drv006.hs b/testsuite/tests/deriving/should_compile/drv006.hs new file mode 100644 index 0000000000..62f2cbcf67 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv006.hs @@ -0,0 +1,9 @@ +-- !!! simple examples of deriving Ix +-- +module ShouldSucceed where +import Data.Ix + +data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8 + deriving (Eq, Ord, Ix, Show) + +data Bar a b = MkBar a Int b Integer a diff --git a/testsuite/tests/deriving/should_compile/drv006.stderr b/testsuite/tests/deriving/should_compile/drv006.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv006.stderr diff --git a/testsuite/tests/deriving/should_compile/drv007.hs b/testsuite/tests/deriving/should_compile/drv007.hs new file mode 100644 index 0000000000..22da5b4aa3 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv007.hs @@ -0,0 +1,6 @@ +-- !!! deriving Ord on d. type with a single nullary constructor. +-- (from ghc-2.10 panic - as reported by Sergey Mechveliani <mechvel@botik.ru>) +-- +module ShouldSucceed where + +data D = D deriving (Eq,Ord) diff --git a/testsuite/tests/deriving/should_compile/drv007.stderr b/testsuite/tests/deriving/should_compile/drv007.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv007.stderr diff --git a/testsuite/tests/deriving/should_compile/drv008.hs b/testsuite/tests/deriving/should_compile/drv008.hs new file mode 100644 index 0000000000..b615809caa --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv008.hs @@ -0,0 +1,7 @@ +-- !!! deriving Ix on d. type with nullary constructors +module ShouldSucceed where + +import Data.Ix + +data AD = A | B | C | D deriving (Show, Ord, Eq, Ix) + diff --git a/testsuite/tests/deriving/should_compile/drv008.stderr b/testsuite/tests/deriving/should_compile/drv008.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv008.stderr diff --git a/testsuite/tests/deriving/should_compile/drv009.hs b/testsuite/tests/deriving/should_compile/drv009.hs new file mode 100644 index 0000000000..4ac069d30c --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv009.hs @@ -0,0 +1,6 @@ +-- !!! deriving Ix on d. type with one constructor +module ShouldSucceed where + +import Data.Ix + +data Pair a b = Pair a b deriving (Show, Ord, Eq, Ix) diff --git a/testsuite/tests/deriving/should_compile/drv009.stderr b/testsuite/tests/deriving/should_compile/drv009.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv009.stderr diff --git a/testsuite/tests/deriving/should_compile/drv010.hs b/testsuite/tests/deriving/should_compile/drv010.hs new file mode 100644 index 0000000000..1a3f9dc33a --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv010.hs @@ -0,0 +1,4 @@ +-- !!! deriving Enum on d. type with nullary constructors +module ShouldSucceed where + +data AD = A | B | C | D deriving (Enum) diff --git a/testsuite/tests/deriving/should_compile/drv010.stderr b/testsuite/tests/deriving/should_compile/drv010.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv010.stderr diff --git a/testsuite/tests/deriving/should_compile/drv011.hs b/testsuite/tests/deriving/should_compile/drv011.hs new file mode 100644 index 0000000000..bba25f5cae --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv011.hs @@ -0,0 +1,6 @@ +-- !!! deriving Enum, but not Ord. +module ShouldSucceed where + +data ABC = A | B | C deriving Enum + +x = [A ..C] diff --git a/testsuite/tests/deriving/should_compile/drv012.hs b/testsuite/tests/deriving/should_compile/drv012.hs new file mode 100644 index 0000000000..eb8f3847cd --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv012.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE GADTs #-} + +-- !!! deriving for GADTs which declare Haskell98 data types. +-- bug reported as http://hackage.haskell.org/trac/ghc/ticket/902 +module ShouldSucceed where + +data Maybe1 a where { + Nothing1 :: Maybe1 a ; + Just1 :: a -> Maybe1 a + } deriving (Eq,Ord) diff --git a/testsuite/tests/deriving/should_compile/drv013.hs b/testsuite/tests/deriving/should_compile/drv013.hs new file mode 100644 index 0000000000..1686bcc232 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv013.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +-- Deriving Typeable has various special cases +module Foo where + +import Data.Typeable + +data Foo1 = Foo1 deriving( Typeable ) +data Foo2 a = Foo2 a deriving( Typeable ) +data Foo3 a b = Foo3 a b deriving( Typeable ) + diff --git a/testsuite/tests/deriving/should_compile/drv014.hs b/testsuite/tests/deriving/should_compile/drv014.hs new file mode 100644 index 0000000000..12e2a15b3f --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv014.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-} + +module ShouldCompile where + +data T a = T1 a | T2 +newtype N = MkN Int + +deriving instance Eq a => Eq (T a) +deriving instance Num N +deriving instance Eq N +deriving instance Show N diff --git a/testsuite/tests/deriving/should_compile/drv015.hs b/testsuite/tests/deriving/should_compile/drv015.hs new file mode 100644 index 0000000000..f8cfbce2db --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv015.hs @@ -0,0 +1,14 @@ + +-- July 07: I'm changing this from "should_compile" to "should_fail". +-- It would generate an instance decl like +-- insance (Show (f a), Show (g a)) => Show (Pair1 f g a) +-- and that is not Haskell 98. +-- +-- See Note [Exotic derived instance contexts] in TcSimplify. +-- The rule is simple: the context of a derived instance decl must +-- contain constraints of form (C tyvar) only, just as H98. + +module ShouldCompile where + +newtype Pair1 f g a = Pair1 {unPair1 :: (f a, g a)} + deriving (Eq, Ord, Show) diff --git a/testsuite/tests/deriving/should_compile/drv020.hs b/testsuite/tests/deriving/should_compile/drv020.hs new file mode 100644 index 0000000000..8794b745e5 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv020.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, + FlexibleInstances, GeneralizedNewtypeDeriving #-} + +-- Test deriving of a multi-parameter class for +-- one-argument newtype defined in the same module +module ShouldSucceed where + +-- library stuff + +class Monad m => MonadState s m | m -> s where + get :: m s + put :: s -> m () + +newtype State s a = State { + runState :: (s -> (a, s)) + } + +instance Monad (State s) where + return a = State $ \s -> (a, s) + m >>= k = State $ \s -> let + (a, s') = runState m s + in runState (k a) s' + +instance MonadState s (State s) where + get = State $ \s -> (s, s) + put s = State $ \_ -> ((), s) + +-- test code + +newtype Foo a = MkFoo (State Int a) + deriving (Monad, MonadState Int) + +f :: Foo Int +f = get diff --git a/testsuite/tests/deriving/should_compile/drv021.hs b/testsuite/tests/deriving/should_compile/drv021.hs new file mode 100644 index 0000000000..c9800508de --- /dev/null +++ b/testsuite/tests/deriving/should_compile/drv021.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -XDeriveDataTypeable -XStandaloneDeriving #-} + +-- See Trac #1825 +-- Test stand-alone deriving for Typeable +-- Horridly, one needs to define instance for Typeable1 etc + +module ShouldCompile where + +import Data.Typeable + +data T1 a = T1 a +data T2 a b = T2 a b + +deriving instance Typeable1 T1 +deriving instance Typeable2 T2 + diff --git a/testsuite/tests/deriving/should_fail/Makefile b/testsuite/tests/deriving/should_fail/Makefile new file mode 100644 index 0000000000..0f0995d29d --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Makefile @@ -0,0 +1,8 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +drvfail016: + $(RM) -f drvfail016.hi-boot drvfail016.o-boot + '$(TEST_HC)' $(TEST_HC_OPTS) -XGeneralizedNewtypeDeriving -c drvfail016.hs-boot; echo $$? + diff --git a/testsuite/tests/deriving/should_fail/T2394.hs b/testsuite/tests/deriving/should_fail/T2394.hs new file mode 100644 index 0000000000..6e62bc364e --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T2394.hs @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -XDeriveDataTypeable -XStandaloneDeriving #-} + +-- Test Trac #2394 + +module Foo where + +import Data.Data(Data) + +deriving instance (Data a,Data b) => Data (a->b) diff --git a/testsuite/tests/deriving/should_fail/T2394.stderr b/testsuite/tests/deriving/should_fail/T2394.stderr new file mode 100644 index 0000000000..9972186ed5 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T2394.stderr @@ -0,0 +1,6 @@ +
+T2394.hs:9:1:
+ Can't make a derived instance of `Data (a -> b)':
+ The last argument of the instance must be a data or newtype application
+ In the stand-alone deriving instance for
+ `(Data a, Data b) => Data (a -> b)'
diff --git a/testsuite/tests/deriving/should_fail/T2604.hs b/testsuite/tests/deriving/should_fail/T2604.hs new file mode 100644 index 0000000000..0f830d992b --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T2604.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Test where + +import Data.Typeable + +data DList a = DList [a] deriving(Typeable) + +newtype NList a = NList [a] deriving(Typeable) diff --git a/testsuite/tests/deriving/should_fail/T2604.stderr b/testsuite/tests/deriving/should_fail/T2604.stderr new file mode 100644 index 0000000000..fa09654c5b --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T2604.stderr @@ -0,0 +1,10 @@ +
+T2604.hs:7:35:
+ Can't make a derived instance of `Typeable (DList a)':
+ You need -XDeriveDataTypeable to derive an instance for this class
+ In the data type declaration for `DList'
+
+T2604.hs:9:38:
+ Can't make a derived instance of `Typeable (NList a)':
+ You need -XDeriveDataTypeable to derive an instance for this class
+ In the newtype declaration for `NList'
diff --git a/testsuite/tests/deriving/should_fail/T2604.stderr-7.0 b/testsuite/tests/deriving/should_fail/T2604.stderr-7.0 new file mode 100644 index 0000000000..aa996e0f87 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T2604.stderr-7.0 @@ -0,0 +1,11 @@ +
+T2604.hs:7:35:
+ Can't make a derived instance of `Typeable (DList a)':
+ You need -XDeriveDataTypeable to derive an instance for this class
+ In the data type declaration for `DList'
+
+T2604.hs:9:38:
+ Can't make a derived instance of `Typeable (NList a)'
+ (even with cunning newtype deriving): + You need -XDeriveDataTypeable to derive an instance for this class
+ In the newtype declaration for `NList'
diff --git a/testsuite/tests/deriving/should_fail/T2701.hs b/testsuite/tests/deriving/should_fail/T2701.hs new file mode 100644 index 0000000000..37bffc827d --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T2701.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE MagicHash, DeriveDataTypeable #-}
+module T2700 where
+
+import GHC.Prim
+
+import Data.Data
+import Data.Typeable
+
+data Foo = MkFoo Int#
+ deriving (Typeable, Data)
diff --git a/testsuite/tests/deriving/should_fail/T2701.stderr b/testsuite/tests/deriving/should_fail/T2701.stderr new file mode 100644 index 0000000000..a9181accc1 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T2701.stderr @@ -0,0 +1,5 @@ + +T2701.hs:10:32: + Can't make a derived instance of `Data Foo': + Constructor `MkFoo' must have only arguments of lifted type + In the data type declaration for `Foo' diff --git a/testsuite/tests/deriving/should_fail/T2721.hs b/testsuite/tests/deriving/should_fail/T2721.hs new file mode 100644 index 0000000000..f6485ce514 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T2721.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-} + +-- Trac #2721 + +module T2721 where + +class C a where + type T a + foo :: a -> T a + +instance C Int where + type T Int = Int + foo = id + +newtype N = N Int deriving(C) diff --git a/testsuite/tests/deriving/should_fail/T2721.stderr b/testsuite/tests/deriving/should_fail/T2721.stderr new file mode 100644 index 0000000000..03339d3bfa --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T2721.stderr @@ -0,0 +1,6 @@ +
+T2721.hs:15:28:
+ Can't make a derived instance of `C N'
+ (even with cunning newtype deriving):
+ the class has associated types
+ In the newtype declaration for `N'
diff --git a/testsuite/tests/deriving/should_fail/T2851.hs b/testsuite/tests/deriving/should_fail/T2851.hs new file mode 100644 index 0000000000..bc7239af0a --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T2851.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies #-} +-- Test Trac #2851 + +module T2851 where + +type family F a :: * + +data D a = D (F a) + deriving (Show) diff --git a/testsuite/tests/deriving/should_fail/T2851.stderr b/testsuite/tests/deriving/should_fail/T2851.stderr new file mode 100644 index 0000000000..a2beb9869d --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T2851.stderr @@ -0,0 +1,9 @@ + +T2851.hs:9:15: + No instance for (Show (F a)) + arising from the 'deriving' clause of a data type declaration + Possible fix: + add an instance declaration for (Show (F a)) + or use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Show (D a)) diff --git a/testsuite/tests/deriving/should_fail/T3101.hs b/testsuite/tests/deriving/should_fail/T3101.hs new file mode 100644 index 0000000000..134694a4fe --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T3101.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RankNTypes #-} + +module T3101 where + +type family F a :: * + +data Boom = Boom (forall a. F a) + deriving Show diff --git a/testsuite/tests/deriving/should_fail/T3101.stderr b/testsuite/tests/deriving/should_fail/T3101.stderr new file mode 100644 index 0000000000..34f423daff --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T3101.stderr @@ -0,0 +1,6 @@ + +T3101.hs:9:12: + Can't make a derived instance of `Show Boom': + Constructor `Boom' must have a Haskell-98 type + Possible fix: use a standalone deriving declaration instead + In the data type declaration for `Boom' diff --git a/testsuite/tests/deriving/should_fail/T3621.hs b/testsuite/tests/deriving/should_fail/T3621.hs new file mode 100644 index 0000000000..cd574eab81 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T3621.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, FlexibleContexts, UndecidableInstances, StandaloneDeriving #-} +module T3621 where + +-- This one is ok, even though the deriving clause mentions 'a' +-- which is not a parameter of 'T' +class C a b +instance C a S +data S = MkS + +newtype T = MkT S deriving( C a ) + + +-- But this one fails, and should fail +class (Monad m) => MonadState s m | m -> s where + +newtype State s a = State { runState :: s -> (a, s) } +instance Monad (State s) where {} +instance MonadState s (State s) where {} + +newtype WrappedState s a = WS { runWS :: State s a } + deriving (Monad, MonadState state) +-- deriving (Monad) + +deriving instance (MonadState state (State s)) + => MonadState state (WrappedState s) + +-- ASSERT error +-- deriving instance (MonadState state (State s), Monad (WrappedState s)) +-- => MonadState s (WrappedState s) + + +-- We try +-- instance MonadState state (State state a) +-- => MonadState state (WrappedState state a) +-- +-- Superclass needs (Monad (WrappedState state a)) diff --git a/testsuite/tests/deriving/should_fail/T3621.stderr b/testsuite/tests/deriving/should_fail/T3621.stderr new file mode 100644 index 0000000000..dc9dc849ab --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T3621.stderr @@ -0,0 +1,13 @@ + +T3621.hs:21:21: + Couldn't match type `s' with `state' + `s' is an unknown type variable + `state' is an unknown type variable + When using functional dependencies to combine + MonadState s (State s), + arising from the dependency `m -> s' + in the instance declaration at T3621.hs:18:10 + MonadState state (State s), + arising from the 'deriving' clause of a data type declaration + at T3621.hs:21:21-36 + When deriving the instance for (MonadState state (WrappedState s)) diff --git a/testsuite/tests/deriving/should_fail/T3833.hs b/testsuite/tests/deriving/should_fail/T3833.hs new file mode 100644 index 0000000000..d1196c4112 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T3833.hs @@ -0,0 +1,9 @@ + +{-# LANGUAGE StandaloneDeriving #-} +-- {-# LANGUAGE GeneralizedNewtypeDeriving #-} + +import Data.Monoid + +newtype DecodeMap e = DecodeMap [e] + +deriving instance Monoid (DecodeMap e) diff --git a/testsuite/tests/deriving/should_fail/T3833.stderr b/testsuite/tests/deriving/should_fail/T3833.stderr new file mode 100644 index 0000000000..2d31cc1364 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T3833.stderr @@ -0,0 +1,6 @@ + +T3833.hs:9:1: + Can't make a derived instance of `Monoid (DecodeMap e)': + `Monoid' is not a derivable class + Try -XGeneralizedNewtypeDeriving for GHC's newtype-deriving extension + In the stand-alone deriving instance for `Monoid (DecodeMap e)' diff --git a/testsuite/tests/deriving/should_fail/T3834.hs b/testsuite/tests/deriving/should_fail/T3834.hs new file mode 100644 index 0000000000..614170198e --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T3834.hs @@ -0,0 +1,9 @@ + +{-# LANGUAGE StandaloneDeriving #-} + +class C a +instance C Int + +newtype T = T Int +deriving instance C T + diff --git a/testsuite/tests/deriving/should_fail/T3834.stderr b/testsuite/tests/deriving/should_fail/T3834.stderr new file mode 100644 index 0000000000..199b4bb799 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T3834.stderr @@ -0,0 +1,6 @@ + +T3834.hs:8:1: + Can't make a derived instance of `C T': + `C' is not a derivable class + Try -XGeneralizedNewtypeDeriving for GHC's newtype-deriving extension + In the stand-alone deriving instance for `C T' diff --git a/testsuite/tests/deriving/should_fail/T4528.hs b/testsuite/tests/deriving/should_fail/T4528.hs new file mode 100644 index 0000000000..23a8510d98 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T4528.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs, StandaloneDeriving #-} + +module T4528 where + +data Foo a where + A, B :: Foo Int + C :: Foo Bool + +deriving instance Enum (Foo a) +deriving instance Bounded (Foo a) + diff --git a/testsuite/tests/deriving/should_fail/T4528.stderr b/testsuite/tests/deriving/should_fail/T4528.stderr new file mode 100644 index 0000000000..8f008e8908 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T4528.stderr @@ -0,0 +1,14 @@ + +T4528.hs:9:1: + Can't make a derived instance of `Enum (Foo a)': + `Foo' must be an enumeration type + (an enumeration consists of one or more nullary, non-GADT constructors) + In the stand-alone deriving instance for `Enum (Foo a)' + +T4528.hs:10:1: + Can't make a derived instance of `Bounded (Foo a)': + `Foo' must be an enumeration type + (an enumeration consists of one or more nullary, non-GADT constructors) + or + `Foo' must have precisely one constructor + In the stand-alone deriving instance for `Bounded (Foo a)' diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T new file mode 100644 index 0000000000..8fa5e27e60 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/all.T @@ -0,0 +1,35 @@ + +test('drvfail001', normal, compile_fail, ['']) +test('drvfail002', normal, compile_fail, ['']) +test('drvfail003', normal, compile_fail, ['']) +test('drvfail004', normal, compile_fail, ['']) +test('drvfail005', normal, compile_fail, ['']) +test('drvfail006', reqlib('mtl'), compile_fail, ['']) +test('drvfail007', normal, compile_fail, ['']) +test('drvfail008', reqlib('mtl'), compile_fail, ['']) +test('drvfail009', normal, compile_fail, ['']) +test('drvfail010', normal, compile_fail, ['']) +test('drvfail011', normal, compile_fail, ['']) +test('drvfail012', normal, compile_fail, ['']) +test('drvfail013', normal, compile_fail, ['']) +test('drvfail014', normal, compile_fail, ['']) +test('drvfail015', normal, compile_fail, ['']) +test('drvfail016', + extra_clean(['drvfail016.hi-boot', 'drvfail016.o-boot']), + run_command, + ['$MAKE --no-print-directory -s drvfail016']) +test('T2394', normal, compile_fail, ['']) +test('T2604', normal, compile_fail, ['']) +test('T2701', normal, compile_fail, ['']) +test('T2851', normal, compile_fail, ['']) +test('T2721', normal, compile_fail, ['']) +test('T3101', normal, compile_fail, ['']) +test('T3621', normal, compile_fail, ['']) +test('drvfail-functor1', normal, compile_fail, ['']) +test('drvfail-functor2', normal, compile_fail, ['']) +test('drvfail-foldable-traversable1', normal, compile_fail, + ['']) +test('T3833', normal, compile_fail, ['']) +test('T3834', normal, compile_fail, ['']) +test('T4528', normal, compile_fail, ['']) + diff --git a/testsuite/tests/deriving/should_fail/drvfail-foldable-traversable1.hs b/testsuite/tests/deriving/should_fail/drvfail-foldable-traversable1.hs new file mode 100644 index 0000000000..ced3f98c63 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail-foldable-traversable1.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} +module ShouldFail where + +import Data.Foldable +import Data.Traversable + +-- Derive Traversable without Functor +data Trivial1 a = Trivial1 a + deriving (Foldable,Traversable) + +-- Derive Traversable without Foldable +data Trivial2 a = Trivial2 a + deriving (Functor,Traversable) + +-- Foldable with function type +data Infinite a = Infinite (Int -> a) + deriving (Functor,Foldable,Traversable) + +-- Foldable with function type +data Cont r a = Cont ((a -> r) -> r) + deriving (Functor,Foldable,Traversable) diff --git a/testsuite/tests/deriving/should_fail/drvfail-foldable-traversable1.stderr b/testsuite/tests/deriving/should_fail/drvfail-foldable-traversable1.stderr new file mode 100644 index 0000000000..ecd20e8372 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail-foldable-traversable1.stderr @@ -0,0 +1,38 @@ + +drvfail-foldable-traversable1.hs:9:23: + No instance for (Functor Trivial1) + arising from the 'deriving' clause of a data type declaration + Possible fix: + add an instance declaration for (Functor Trivial1) + or use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Traversable Trivial1) + +drvfail-foldable-traversable1.hs:13:22: + No instance for (Foldable Trivial2) + arising from the 'deriving' clause of a data type declaration + Possible fix: + add an instance declaration for (Foldable Trivial2) + or use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Traversable Trivial2) + +drvfail-foldable-traversable1.hs:17:22: + Can't make a derived instance of `Foldable Infinite': + Constructor `Infinite' must not contain function types + In the data type declaration for `Infinite' + +drvfail-foldable-traversable1.hs:17:31: + Can't make a derived instance of `Traversable Infinite': + Constructor `Infinite' must not contain function types + In the data type declaration for `Infinite' + +drvfail-foldable-traversable1.hs:21:22: + Can't make a derived instance of `Foldable (Cont r)': + Constructor `Cont' must not contain function types + In the data type declaration for `Cont' + +drvfail-foldable-traversable1.hs:21:31: + Can't make a derived instance of `Traversable (Cont r)': + Constructor `Cont' must not contain function types + In the data type declaration for `Cont' diff --git a/testsuite/tests/deriving/should_fail/drvfail-functor1.hs b/testsuite/tests/deriving/should_fail/drvfail-functor1.hs new file mode 100644 index 0000000000..94ebd925b8 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail-functor1.hs @@ -0,0 +1,6 @@ +module ShouldFail where + +-- Derive Functor without a DeriveFunctor language pragma + +data List a = Nil | Cons a (List a) + deriving Functor diff --git a/testsuite/tests/deriving/should_fail/drvfail-functor1.stderr b/testsuite/tests/deriving/should_fail/drvfail-functor1.stderr new file mode 100644 index 0000000000..d221f99f9d --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail-functor1.stderr @@ -0,0 +1,5 @@ +
+drvfail-functor1.hs:6:14:
+ Can't make a derived instance of `Functor List':
+ You need -XDeriveFunctor to derive an instance for this class
+ In the data type declaration for `List'
diff --git a/testsuite/tests/deriving/should_fail/drvfail-functor2.hs b/testsuite/tests/deriving/should_fail/drvfail-functor2.hs new file mode 100644 index 0000000000..7198755b80 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail-functor2.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE DeriveFunctor, DatatypeContexts #-} +module ShouldFail where + +-- Derive Functor on a type that uses 'a' in the wrong places + +newtype InFunctionArgument a = InFunctionArgument (a -> Int) + deriving (Functor) + +newtype OnSecondArg a = OnSecondArg (Either a a) + deriving (Functor) + +-- Derive Functor on a type with no arguments + +newtype NoArguments = NoArguments Int + deriving (Functor) + +-- Derive Functor on a type with extra stupid-contraints on 'a' + +data Eq a => StupidConstraint a = StupidType a + deriving (Functor) + +-- A missing Functor instance + +data NoFunctor a = NoFunctor +data UseNoFunctor a = UseNoFunctor (NoFunctor a) + deriving (Functor) diff --git a/testsuite/tests/deriving/should_fail/drvfail-functor2.stderr b/testsuite/tests/deriving/should_fail/drvfail-functor2.stderr new file mode 100644 index 0000000000..7ce404666f --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail-functor2.stderr @@ -0,0 +1,32 @@ + +drvfail-functor2.hs:1:29: + Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. + +drvfail-functor2.hs:7:14: + Can't make a derived instance of `Functor InFunctionArgument': + Constructor `InFunctionArgument' must not use the type variable in a function argument + In the newtype declaration for `InFunctionArgument' + +drvfail-functor2.hs:10:14: + Can't make a derived instance of `Functor OnSecondArg': + Constructor `OnSecondArg' must not use the type variable in an argument other than the last + In the newtype declaration for `OnSecondArg' + +drvfail-functor2.hs:15:14: + Cannot derive well-kinded instance of form `Functor (NoArguments ...)' + Class `Functor' expects an argument of kind `* -> *' + In the newtype declaration for `NoArguments' + +drvfail-functor2.hs:20:14: + Can't make a derived instance of `Functor StupidConstraint': + Data type `StupidConstraint' must not have a class context (Eq a) + In the data type declaration for `StupidConstraint' + +drvfail-functor2.hs:26:14: + No instance for (Functor NoFunctor) + arising from the 'deriving' clause of a data type declaration + Possible fix: + add an instance declaration for (Functor NoFunctor) + or use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Functor UseNoFunctor) diff --git a/testsuite/tests/deriving/should_fail/drvfail001.hs b/testsuite/tests/deriving/should_fail/drvfail001.hs new file mode 100644 index 0000000000..47447fb3e3 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail001.hs @@ -0,0 +1,26 @@ +{- From: Ian Bayley + Sent: Tuesday, June 29, 1999 3:39 PM + To: hugs-bugs@haskell.org + Subject: Show for higher-order nested datatypes + + + Is "deriving Show" meant to work for higher-order nested datatypes ? + Hugs hangs when loading in the following file: +-} + +module Foo where + +type SqMat a = SM Nil a + +data SM f a = ZeroS (f (f a)) | SuccS (SM (Cons f) a) + deriving Show + +-- Show (f (f a)), Show (SM (Cons f) a) => Show (SM f a) + +data Nil a = MkNil deriving Show + +data Cons f a = MkCons a (f a) + deriving Show + + + diff --git a/testsuite/tests/deriving/should_fail/drvfail001.stderr b/testsuite/tests/deriving/should_fail/drvfail001.stderr new file mode 100644 index 0000000000..a2a149594c --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail001.stderr @@ -0,0 +1,9 @@ + +drvfail001.hs:16:33: + No instance for (Show (f (f a))) + arising from the 'deriving' clause of a data type declaration + Possible fix: + add an instance declaration for (Show (f (f a))) + or use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Show (SM f a)) diff --git a/testsuite/tests/deriving/should_fail/drvfail002.hs b/testsuite/tests/deriving/should_fail/drvfail002.hs new file mode 100644 index 0000000000..26a8f083d2 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail002.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE UndecidableInstances, + MultiParamTypeClasses, FunctionalDependencies #-} + +-- The Show instance for S would have form +-- instance X T c => Show S +-- which is hard to deal with. It sent GHC 5.01 into +-- an infinite loop; now it should be rejected. + +module ShouldFail where + +data T = T Integer + +class X a b | a -> b where + f :: a -> b + +instance X T c => Show T where + show _ = "" + +data S = S T deriving Show + diff --git a/testsuite/tests/deriving/should_fail/drvfail002.stderr b/testsuite/tests/deriving/should_fail/drvfail002.stderr new file mode 100644 index 0000000000..c174c69055 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail002.stderr @@ -0,0 +1,6 @@ + +drvfail002.hs:16:10: + Ambiguous constraint `X T c' + At least one of the forall'd type variables mentioned by the constraint + must be reachable from the type after the '=>' + In the instance declaration for `Show T' diff --git a/testsuite/tests/deriving/should_fail/drvfail002.stderr-hugs b/testsuite/tests/deriving/should_fail/drvfail002.stderr-hugs new file mode 100644 index 0000000000..b67a94ef5c --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail002.stderr-hugs @@ -0,0 +1 @@ +ERROR "drvfail002.hs":18 - An instance of X T a is required to derive Show S diff --git a/testsuite/tests/deriving/should_fail/drvfail003.hs b/testsuite/tests/deriving/should_fail/drvfail003.hs new file mode 100644 index 0000000000..5d22dc1d4a --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail003.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE FlexibleContexts #-} +-- Made GHC 5.02.2 go into a loop when doing the +-- context inference for deriving. It only happened with +-- the -fglasgow-exts flag (it didn't diverge without), +-- so hopefully FlexibleContexts is the relevant extension. + +module ShouldFail where + +data Empty a = E +newtype Id a = I a +newtype Pair v w a = P ((v a), (w a)) +type Square a = Square_ Empty Id a +data Square_ v w a = + End (v (v a)) + | Zero (Square_ v (Pair w w) a) + | One (Square_ (Pair v w) (Pair w w) a) deriving Show diff --git a/testsuite/tests/deriving/should_fail/drvfail003.stderr b/testsuite/tests/deriving/should_fail/drvfail003.stderr new file mode 100644 index 0000000000..4aa98531b8 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail003.stderr @@ -0,0 +1,9 @@ + +drvfail003.hs:16:56: + No instance for (Show (v (v a))) + arising from the 'deriving' clause of a data type declaration + Possible fix: + add an instance declaration for (Show (v (v a))) + or use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Show (Square_ v w a)) diff --git a/testsuite/tests/deriving/should_fail/drvfail003.stderr-hugs b/testsuite/tests/deriving/should_fail/drvfail003.stderr-hugs new file mode 100644 index 0000000000..0dab54095c --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail003.stderr-hugs @@ -0,0 +1 @@ +ERROR "drvfail003.hs":13 - An instance of Show (Pair a b (Pair a b c)) is required to derive Show (Square_ a b c) diff --git a/testsuite/tests/deriving/should_fail/drvfail004.hs b/testsuite/tests/deriving/should_fail/drvfail004.hs new file mode 100644 index 0000000000..8716a5837f --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail004.hs @@ -0,0 +1,9 @@ +-- !!! deriving Ord without deriving Eq +-- +module ShouldFail where + +data Foo a b + = C1 a Int + | C2 b Double + deriving Ord + diff --git a/testsuite/tests/deriving/should_fail/drvfail004.stderr b/testsuite/tests/deriving/should_fail/drvfail004.stderr new file mode 100644 index 0000000000..d08f315cb7 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail004.stderr @@ -0,0 +1,9 @@ + +drvfail004.hs:8:12: + No instance for (Eq (Foo a b)) + arising from the 'deriving' clause of a data type declaration + Possible fix: + add an instance declaration for (Eq (Foo a b)) + or use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Ord (Foo a b)) diff --git a/testsuite/tests/deriving/should_fail/drvfail004.stderr-hugs b/testsuite/tests/deriving/should_fail/drvfail004.stderr-hugs new file mode 100644 index 0000000000..4370d8e96c --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail004.stderr-hugs @@ -0,0 +1,4 @@ +ERROR "drvfail004.hs":6 - Cannot build superclass instance +*** Instance : Ord (Foo a b) +*** Context supplied : (Ord a, Ord b) +*** Required superclass : Eq (Foo a b) diff --git a/testsuite/tests/deriving/should_fail/drvfail005.hs b/testsuite/tests/deriving/should_fail/drvfail005.hs new file mode 100644 index 0000000000..ee44e2f343 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail005.hs @@ -0,0 +1,4 @@ +module ShouldFail where + +data Test a = T a + deriving( Show a, Read ) diff --git a/testsuite/tests/deriving/should_fail/drvfail005.stderr b/testsuite/tests/deriving/should_fail/drvfail005.stderr new file mode 100644 index 0000000000..e27f3c1fd2 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail005.stderr @@ -0,0 +1,5 @@ +
+drvfail005.hs:4:13:
+ Can't make a derived instance of `Show a (Test a)':
+ `Show a' is not a class
+ In the data type declaration for `Test'
diff --git a/testsuite/tests/deriving/should_fail/drvfail006.hs b/testsuite/tests/deriving/should_fail/drvfail006.hs new file mode 100644 index 0000000000..0d8d1a95d9 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail006.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- Testing the newtype-deriving stuff + +module ShouldFail where + +import Control.Monad.State + +newtype T a = T (StateT Int IO a) deriving( MonadState ) + -- Here MonadState takes two type params, + -- but exactly one is needed.
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_fail/drvfail006.stderr b/testsuite/tests/deriving/should_fail/drvfail006.stderr new file mode 100644 index 0000000000..018291b6bb --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail006.stderr @@ -0,0 +1,6 @@ +
+drvfail006.hs:9:45:
+ Can't make a derived instance of `MonadState T'
+ (even with cunning newtype deriving):
+ `MonadState' does not have arity 1
+ In the newtype declaration for `T'
diff --git a/testsuite/tests/deriving/should_fail/drvfail006.stderr-hugs b/testsuite/tests/deriving/should_fail/drvfail006.stderr-hugs new file mode 100644 index 0000000000..b4c1c277a0 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail006.stderr-hugs @@ -0,0 +1 @@ +ERROR "drvfail006.hs":9 - Cannot derive instances of class "MonadState" diff --git a/testsuite/tests/deriving/should_fail/drvfail007.hs b/testsuite/tests/deriving/should_fail/drvfail007.hs new file mode 100644 index 0000000000..74f9f033d3 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail007.hs @@ -0,0 +1,4 @@ +-- !!! buggy deriving with function type, reported by Sigbjorn Finne +module ShouldFail where + +data Foo = Foo (Int -> Int) deriving Eq diff --git a/testsuite/tests/deriving/should_fail/drvfail007.stderr b/testsuite/tests/deriving/should_fail/drvfail007.stderr new file mode 100644 index 0000000000..7dc7124fd1 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail007.stderr @@ -0,0 +1,9 @@ + +drvfail007.hs:4:38: + No instance for (Eq (Int -> Int)) + arising from the 'deriving' clause of a data type declaration + Possible fix: + add an instance declaration for (Eq (Int -> Int)) + or use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Eq Foo) diff --git a/testsuite/tests/deriving/should_fail/drvfail007.stderr-hugs b/testsuite/tests/deriving/should_fail/drvfail007.stderr-hugs new file mode 100644 index 0000000000..3285aeeb78 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail007.stderr-hugs @@ -0,0 +1 @@ +ERROR "drvfail007.hs":4 - An instance of Eq (Int -> Int) is required to derive Eq Foo diff --git a/testsuite/tests/deriving/should_fail/drvfail008.hs b/testsuite/tests/deriving/should_fail/drvfail008.hs new file mode 100644 index 0000000000..af8628b4d5 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail008.hs @@ -0,0 +1,14 @@ +-- Should fail without GeneralizedNewtypeDeriving +-- Succeeds with GeneralizedNewtypeDeriving + +module ShouldFail where + +import Control.Monad.State + +data S = S Int + +newtype M a = M (StateT S IO a) deriving( Monad ) + + + + diff --git a/testsuite/tests/deriving/should_fail/drvfail008.stderr b/testsuite/tests/deriving/should_fail/drvfail008.stderr new file mode 100644 index 0000000000..9b56dfb1d7 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail008.stderr @@ -0,0 +1,6 @@ +
+drvfail008.hs:10:43:
+ Can't make a derived instance of `Monad M':
+ `Monad' is not a derivable class
+ Try -XGeneralizedNewtypeDeriving for GHC's newtype-deriving extension
+ In the newtype declaration for `M'
diff --git a/testsuite/tests/deriving/should_fail/drvfail009.hs b/testsuite/tests/deriving/should_fail/drvfail009.hs new file mode 100644 index 0000000000..06155c38a1 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail009.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} + +-- Various newtype-deriving failures + +module ShouldFail where + + +class C a b + +newtype T1 = T1 Int deriving( C ) + -- Wrong arity + +newtype T2 = T2 Int deriving( Monad ) + -- Type constructor has wrong kind + +newtype T3 a = T3 Int deriving( Monad ) + -- Rep type has wrong kind + +newtype T4 a = T4 (Either a a) deriving( Monad ) + -- Eta fails diff --git a/testsuite/tests/deriving/should_fail/drvfail009.stderr b/testsuite/tests/deriving/should_fail/drvfail009.stderr new file mode 100644 index 0000000000..7594baef39 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail009.stderr @@ -0,0 +1,23 @@ +
+drvfail009.hs:10:31:
+ Can't make a derived instance of `C T1'
+ (even with cunning newtype deriving):
+ `C' does not have arity 1
+ In the newtype declaration for `T1'
+
+drvfail009.hs:13:31:
+ Cannot derive well-kinded instance of form `Monad (T2 ...)'
+ Class `Monad' expects an argument of kind `* -> *'
+ In the newtype declaration for `T2'
+
+drvfail009.hs:16:33:
+ Can't make a derived instance of `Monad T3'
+ (even with cunning newtype deriving):
+ cannot eta-reduce the representation type enough
+ In the newtype declaration for `T3'
+
+drvfail009.hs:19:42:
+ Can't make a derived instance of `Monad T4'
+ (even with cunning newtype deriving):
+ cannot eta-reduce the representation type enough
+ In the newtype declaration for `T4'
diff --git a/testsuite/tests/deriving/should_fail/drvfail009.stderr-hugs b/testsuite/tests/deriving/should_fail/drvfail009.stderr-hugs new file mode 100644 index 0000000000..79fba84f61 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail009.stderr-hugs @@ -0,0 +1 @@ +ERROR "drvfail009.hs":10 - Cannot derive instances of class "C" diff --git a/testsuite/tests/deriving/should_fail/drvfail010.hs b/testsuite/tests/deriving/should_fail/drvfail010.hs new file mode 100644 index 0000000000..efecf07cf1 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail010.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +module ShouldFail where +import Data.Typeable + +data A a b c d e f g h i j = A deriving (Typeable) + -- Too many args + +data B a b = B (a b) deriving (Typeable) + -- Non type-kind args
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_fail/drvfail010.stderr b/testsuite/tests/deriving/should_fail/drvfail010.stderr new file mode 100644 index 0000000000..a61fb4892f --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail010.stderr @@ -0,0 +1,11 @@ + +drvfail010.hs:6:42: + Can't make a derived instance of + `Typeable (A a b c d e f g h i j)': + `A' must have 7 or fewer arguments + In the data type declaration for `A' + +drvfail010.hs:9:32: + Can't make a derived instance of `Typeable (B a b)': + `B' must only have arguments of kind `*' + In the data type declaration for `B' diff --git a/testsuite/tests/deriving/should_fail/drvfail010.stderr-hugs b/testsuite/tests/deriving/should_fail/drvfail010.stderr-hugs new file mode 100644 index 0000000000..f6479975a5 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail010.stderr-hugs @@ -0,0 +1 @@ +ERROR "drvfail010.hs":6 - Cannot derive instances of class "Typeable" diff --git a/testsuite/tests/deriving/should_fail/drvfail011.hs b/testsuite/tests/deriving/should_fail/drvfail011.hs new file mode 100644 index 0000000000..33e35c4d83 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail011.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE StandaloneDeriving #-} + +module ShouldFail where + +data T a = T1 a | T2 + +-- This fails as we need an (Eq a) context +deriving instance Eq (T a) diff --git a/testsuite/tests/deriving/should_fail/drvfail011.stderr b/testsuite/tests/deriving/should_fail/drvfail011.stderr new file mode 100644 index 0000000000..80e486628b --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail011.stderr @@ -0,0 +1,10 @@ + +drvfail011.hs:8:1: + No instance for (Eq a) + arising from a use of `==' + In the expression: ((a1 == b1)) + In an equation for `==': == (T1 a1) (T1 b1) = ((a1 == b1)) + When typechecking the code for `==' + in a standalone derived instance for `Eq (T a)': + To see the code I am typechecking, use -ddump-deriv + In the instance declaration for `Eq (T a)' diff --git a/testsuite/tests/deriving/should_fail/drvfail012.hs b/testsuite/tests/deriving/should_fail/drvfail012.hs new file mode 100644 index 0000000000..4a073bbed1 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail012.hs @@ -0,0 +1,8 @@ +-- Trac #1608 + +module ShouldFail where + +newtype Ego a = Ego a deriving (Ord) + +f :: Ord a => Ego a -> Ego a -> Bool +f e1 e2 = e1 < e2 diff --git a/testsuite/tests/deriving/should_fail/drvfail012.stderr b/testsuite/tests/deriving/should_fail/drvfail012.stderr new file mode 100644 index 0000000000..22fac4887d --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail012.stderr @@ -0,0 +1,9 @@ + +drvfail012.hs:5:33: + No instance for (Eq (Ego a)) + arising from the 'deriving' clause of a data type declaration + Possible fix: + add an instance declaration for (Eq (Ego a)) + or use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Ord (Ego a)) diff --git a/testsuite/tests/deriving/should_fail/drvfail013.hs b/testsuite/tests/deriving/should_fail/drvfail013.hs new file mode 100644 index 0000000000..d8a7322dba --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail013.hs @@ -0,0 +1,6 @@ + +-- Test for trac #1588: unrequested generalized newtype deriving? + +newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } deriving Eq + +data MaybeT' m a = MaybeT' { runMaybeT' :: m (Maybe a) } deriving Eq diff --git a/testsuite/tests/deriving/should_fail/drvfail013.stderr b/testsuite/tests/deriving/should_fail/drvfail013.stderr new file mode 100644 index 0000000000..94927cd790 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail013.stderr @@ -0,0 +1,18 @@ + +drvfail013.hs:4:70: + No instance for (Eq (m (Maybe a))) + arising from the 'deriving' clause of a data type declaration + Possible fix: + add an instance declaration for (Eq (m (Maybe a))) + or use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Eq (MaybeT m a)) + +drvfail013.hs:6:70: + No instance for (Eq (m (Maybe a))) + arising from the 'deriving' clause of a data type declaration + Possible fix: + add an instance declaration for (Eq (m (Maybe a))) + or use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Eq (MaybeT' m a)) diff --git a/testsuite/tests/deriving/should_fail/drvfail014.hs b/testsuite/tests/deriving/should_fail/drvfail014.hs new file mode 100644 index 0000000000..9039332f29 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail014.hs @@ -0,0 +1,13 @@ +{-# OPTIONS_GHC -XDeriveDataTypeable -XStandaloneDeriving #-} + +-- See Trac #1825 + +module ShouldFail where +import Data.Typeable + +data T1 a = T1 a deriving( Typeable1 ) + +data T2 a b = T2 a b + +deriving instance (Typeable a, Typeable b) => Typeable (T2 a b) + -- c.f. drv021.hs diff --git a/testsuite/tests/deriving/should_fail/drvfail014.stderr b/testsuite/tests/deriving/should_fail/drvfail014.stderr new file mode 100644 index 0000000000..865a78c44e --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail014.stderr @@ -0,0 +1,9 @@ + +drvfail014.hs:8:28: + Use deriving( Typeable ) on a data type declaration + In the data type declaration for `T1' + +drvfail014.hs:12:1: + Derived typeable instance must be of form (Typeable2 T2) + In the stand-alone deriving instance for + `(Typeable a, Typeable b) => Typeable (T2 a b)' diff --git a/testsuite/tests/deriving/should_fail/drvfail015.hs b/testsuite/tests/deriving/should_fail/drvfail015.hs new file mode 100644 index 0000000000..32d6134d34 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail015.hs @@ -0,0 +1,13 @@ +{-# OPTIONS_GHC -XStandaloneDeriving #-} + +module ShouldFail where + +import System.IO( Handle ) + + +-- T is a synonym +type T = Int +deriving instance Eq T + +-- Handle is abstract +deriving instance Eq Handle diff --git a/testsuite/tests/deriving/should_fail/drvfail015.stderr b/testsuite/tests/deriving/should_fail/drvfail015.stderr new file mode 100644 index 0000000000..a7d8ac6cf1 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail015.stderr @@ -0,0 +1,13 @@ +
+drvfail015.hs:10:19:
+ Illegal instance declaration for `Eq T'
+ (All instance types must be of the form (T t1 ... tn)
+ where T is not a synonym.
+ Use -XTypeSynonymInstances if you want to disable this.)
+ In the stand-alone deriving instance for `Eq T'
+
+drvfail015.hs:13:1:
+ Can't make a derived instance of `Eq Handle':
+ The data constructors of `Handle' are not all in scope
+ so you cannot derive an instance for it
+ In the stand-alone deriving instance for `Eq Handle'
diff --git a/testsuite/tests/deriving/should_fail/drvfail015.stderr-7.0 b/testsuite/tests/deriving/should_fail/drvfail015.stderr-7.0 new file mode 100644 index 0000000000..9f0166e9cd --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail015.stderr-7.0 @@ -0,0 +1,12 @@ + +drvfail015.hs:10:19: + Illegal instance declaration for `Eq T' + (All instance types must be of the form (T t1 ... tn) + where T is not a synonym. + Use -XTypeSynonymInstances if you want to disable this.) + In the stand-alone deriving instance for `Eq T' + +drvfail015.hs:13:1: + The data constructors of `Handle' are not all in scope + so you cannot derive an instance for it + In the stand-alone deriving instance for `Eq Handle' diff --git a/testsuite/tests/deriving/should_fail/drvfail016.hs-boot b/testsuite/tests/deriving/should_fail/drvfail016.hs-boot new file mode 100644 index 0000000000..b3a388f736 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail016.hs-boot @@ -0,0 +1,7 @@ + +-- trac #2449 + +module A where + +data D + deriving Show diff --git a/testsuite/tests/deriving/should_fail/drvfail016.stderr b/testsuite/tests/deriving/should_fail/drvfail016.stderr new file mode 100644 index 0000000000..1bcb7363b1 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail016.stderr @@ -0,0 +1,4 @@ + +drvfail016.hs-boot:6:1: + Deriving not permitted in hs-boot file + Use an instance declaration instead diff --git a/testsuite/tests/deriving/should_fail/drvfail016.stdout b/testsuite/tests/deriving/should_fail/drvfail016.stdout new file mode 100644 index 0000000000..d00491fd7e --- /dev/null +++ b/testsuite/tests/deriving/should_fail/drvfail016.stdout @@ -0,0 +1 @@ +1 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"] |