[commit: ghc] wip/T9968: Add a test for T9968, and improve T5462Yes1 (78c292d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T9968
Link       : http://ghc.haskell.org/trac/ghc/changeset/78c292d51cfbdc9fada37d6d0e893808d8f0fa49/ghc

>---------------------------------------------------------------

commit 78c292d51cfbdc9fada37d6d0e893808d8f0fa49
Author: Jose Pedro Magalhaes <jpm at cs.ox.ac.uk>
Date:   Thu Feb 19 18:00:58 2015 +0000

    Add a test for T9968, and improve T5462Yes1


>---------------------------------------------------------------

78c292d51cfbdc9fada37d6d0e893808d8f0fa49
 testsuite/tests/generics/T5462Yes1.hs             |  4 +-
 testsuite/tests/generics/T5462Yes1.stdout         |  2 +-
 testsuite/tests/generics/all.T                    |  2 +-
 testsuite/tests/typecheck/should_compile/T9968.hs | 79 +++++++++++++++++++++++
 testsuite/tests/typecheck/should_compile/all.T    |  1 +
 5 files changed, 85 insertions(+), 3 deletions(-)

diff --git a/testsuite/tests/generics/T5462Yes1.hs b/testsuite/tests/generics/T5462Yes1.hs
index b9a0933..254ba95 100644
--- a/testsuite/tests/generics/T5462Yes1.hs
+++ b/testsuite/tests/generics/T5462Yes1.hs
@@ -13,9 +13,10 @@ import GHC.Generics hiding (C, C1, D)
 import GEq1A
 import Enum
 import GFunctor
+import GShow
 
 data A = A1
-  deriving (Show, Generic, GEq, GEnum)
+  deriving (Show, Generic, GEq, GEnum, GShow)
 
 data B a = B1 | B2 a (B a)
   deriving (Show, Generic, Generic1, GEq, GEnum, GFunctor)
@@ -34,6 +35,7 @@ data E f a = E1 (f a)
 main = print (
                geq A1 A1
              , take 10 (genum :: [A])
+             , gshow A1
 
              , geq (B2 A1 B1) B1
              , gmap (++ "lo") (B2 "hel" B1)
diff --git a/testsuite/tests/generics/T5462Yes1.stdout b/testsuite/tests/generics/T5462Yes1.stdout
index 6a2dc67..7aed256 100644
--- a/testsuite/tests/generics/T5462Yes1.stdout
+++ b/testsuite/tests/generics/T5462Yes1.stdout
@@ -1 +1 @@
-(True,[A1],False,B2 "hello" B1,[B1,B2 A1 B1,B2 A1 (B2 A1 B1)],False,C2 "hello" C1,True,E1 ["hello"])
+(True,[A1],"A1",False,B2 "hello" B1,[B1,B2 A1 B1,B2 A1 (B2 A1 B1)],False,C2 "hello" C1,True,E1 ["hello"])
diff --git a/testsuite/tests/generics/all.T b/testsuite/tests/generics/all.T
index c51de18..50894d6 100644
--- a/testsuite/tests/generics/all.T
+++ b/testsuite/tests/generics/all.T
@@ -20,7 +20,7 @@ test('GenCannotDoRep1_7', normal, compile_fail, [''])
 test('GenCannotDoRep1_8', normal, compile_fail, [''])
 
 test('T5462Yes1', extra_clean(['T5462Yes1/GFunctor.hi'])
-    , multimod_compile_and_run, ['T5462Yes1', '-iGEq -iGEnum -iGFunctor -outputdir=out_T5462Yes1'])
+    , multimod_compile_and_run, ['T5462Yes1', '-iGEq -iGEnum -iGFunctor -iGShow -outputdir=out_T5462Yes1'])
 test('T5462Yes2', extra_clean(['T5462Yes2/GFunctor.hi'])
     , multimod_compile_and_run, ['T5462Yes2', '-iGFunctor -outputdir=out_T5462Yes2'])
 test('T5462No1', extra_clean(['T5462No1/GFunctor.hi'])
diff --git a/testsuite/tests/typecheck/should_compile/T9968.hs b/testsuite/tests/typecheck/should_compile/T9968.hs
new file mode 100644
index 0000000..93a2907
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T9968.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE DeriveFoldable             #-}
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE DefaultSignatures          #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE PolyKinds                  #-}
+
+module T9968 where
+
+import GHC.Generics ( Generic(..), Generic1(..), Rep, M1(..) )
+
+
+data D1 = D11
+  deriving (C1, C8)
+
+newtype D2 = D21 Int
+  deriving (C1, C8)
+
+newtype D3 a = D31 a
+  deriving (Show, Foldable, C1, C2, C3 a, C5 Int, C8)
+
+data D4 a = D41
+  deriving (Foldable, C2)
+
+data D5 a b = D51 a | D52 b
+  deriving (C9)
+
+data D6 f a = D61 (f a)
+  deriving (C1, C8)
+
+data D7 h f = D71 (h f) (f Int)
+  deriving (C1, C3 Int, C4)
+
+instance Show (D7 h f) where show = undefined
+
+data Proxy (t :: k) = Proxy
+  deriving (Foldable, C1, C2, C8)
+
+
+class C1 a where
+  c11 :: a -> Int
+  c11 = undefined
+
+class Foldable f => C2 f where
+  c21 :: (Show a) => f a -> String
+  c21 = foldMap show
+
+class C3 a b where
+  c31 :: Read c => a -> b -> c
+  default c31 :: (Show a, Show b, Read c) => a -> b -> c
+  c31 a b = read (show a ++ show b)
+
+class C4 h where
+  c41 :: (f a -> f a) -> h f -> Int
+  c41 = undefined
+
+class C5 a f where
+  c51 :: f a -> Int
+  c51 = undefined
+
+class C6 a where
+  c61 :: a -> Int
+  default c61 :: (Generic a, C7 (Rep a)) => a -> Int
+  c61 = c71 . from
+
+-- trivial generic function that always returns 0
+class C7 f where c71 :: f p -> Int
+instance C7 (M1 i c f) where c71 _ = 0
+
+class C8 (a :: k) where
+  c81 :: Proxy a -> Int
+  c81 _ = 0
+
+class C9 (h :: * -> * -> *) where
+  c91 :: h a b -> Int
+  c91 _ = 0
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index b792629..ec9fdbd 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -438,6 +438,7 @@ test('T7643', normal, compile, [''])
 test('T9834', normal, compile, [''])
 test('T9892', normal, compile, [''])
 test('T9939', normal, compile, [''])
+test('T9968', normal, compile, [''])
 test('T9973', normal, compile, [''])
 test('T9971', normal, compile, [''])
 test('T9999', normal, compile, [''])