Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : ghc-generics
http://hackage.haskell.org/trac/ghc/changeset/6cf1b135ff2864aa902164bcf9f2a9bdd02892bc >--------------------------------------------------------------- commit 6cf1b135ff2864aa902164bcf9f2a9bdd02892bc Author: Jose Pedro Magalhaes <[email protected]> Date: Mon May 23 16:06:13 2011 +0200 Add a new test to test for a strange error when missing FlexibleContexts. >--------------------------------------------------------------- tests/ghc-regress/generics/GEq/GEq2.hs | 78 ++++++++++++++++++++ .../generics/GEq/{GEq1.stdout => GEq2.stdout} | 0 tests/ghc-regress/generics/GEq/test.T | 3 +- 3 files changed, 80 insertions(+), 1 deletions(-) diff --git a/tests/ghc-regress/generics/GEq/GEq2.hs b/tests/ghc-regress/generics/GEq/GEq2.hs new file mode 100644 index 0000000..9ba386e --- /dev/null +++ b/tests/ghc-regress/generics/GEq/GEq2.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE TypeOperators, DefaultSignatures, FlexibleInstances, DeriveGeneric #-} +-- {-# LANGUAGE FlexibleContexts #-} + +module Main where + +import GHC.Generics hiding (C, D) + +class GEq' f where + geq' :: f a -> f a -> Bool + +instance GEq' U1 where + geq' _ _ = True + +instance (GEq c) => GEq' (K1 i c) where + geq' (K1 a) (K1 b) = geq a b + +-- No instances for P or Rec because geq is only applicable to types of kind * + +instance (GEq' a) => GEq' (M1 i c a) where + geq' (M1 a) (M1 b) = geq' a b + +instance (GEq' a, GEq' b) => GEq' (a :+: b) where + geq' (L1 a) (L1 b) = geq' a b + geq' (R1 a) (R1 b) = geq' a b + geq' _ _ = False + +instance (GEq' a, GEq' b) => GEq' (a :*: b) where + geq' (a1 :*: b1) (a2 :*: b2) = geq' a1 a2 && geq' b1 b2 + + +class GEq a where + geq :: a -> a -> Bool + default geq :: (Generic a, GEq' (Rep a)) => a -> a -> Bool + geq x y = geq' (from x) (from y) + + +-- Base types instances (ad-hoc) +instance GEq Char where geq = (==) +instance GEq Int where geq = (==) +instance GEq Float where geq = (==) +{- +-- Generic instances +instance (GEq a) => GEq (Maybe a) +instance (GEq a) => GEq [a] +-} + +data C = C0 | C1 + deriving Generic + +data D a = D0 | D1 { d11 :: a, d12 :: (D a) } + deriving Generic + +data (:**:) a b = a :**: b + deriving Generic + +-- Example values +c0 = C0 +c1 = C1 + +d0 :: D Char +d0 = D0 +d1 = D1 'p' D0 + +p1 :: Int :**: Char +p1 = 3 :**: 'p' + +-- Generic instances +instance GEq C +instance (GEq a) => GEq (D a) +instance (GEq a, GEq b) => GEq (a :**: b) + +-- Tests +teq0 = geq c0 c1 +teq1 = geq d0 d1 +teq2 = geq d0 d0 +teq3 = geq p1 p1 + +main = mapM_ print [teq0, teq1, teq2, teq3] diff --git a/tests/ghc-regress/generics/GEq/GEq1.stdout b/tests/ghc-regress/generics/GEq/GEq2.stdout similarity index 100% copy from tests/ghc-regress/generics/GEq/GEq1.stdout copy to tests/ghc-regress/generics/GEq/GEq2.stdout diff --git a/tests/ghc-regress/generics/GEq/test.T b/tests/ghc-regress/generics/GEq/test.T index ae2cc99..363cb48 100644 --- a/tests/ghc-regress/generics/GEq/test.T +++ b/tests/ghc-regress/generics/GEq/test.T @@ -1,3 +1,4 @@ setTestOpts(only_compiler_types(['ghc'])) -test('GEq1', normal, multimod_compile_and_run, ['Main', '']) \ No newline at end of file +test('GEq1', normal, multimod_compile_and_run, ['Main', '']) +test('GEq2', normal, multimod_compile_and_run, ['GEq2', '']) \ No newline at end of file _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
