diff options
Diffstat (limited to 'testsuite/tests/deriving')
-rw-r--r-- | testsuite/tests/deriving/should_compile/T11509_2.hs | 13 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/T11509_3.hs | 9 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/all.T | 2 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_fail/T11509_1.hs | 52 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_fail/T11509_1.stderr | 7 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_fail/all.T | 2 |
6 files changed, 85 insertions, 0 deletions
diff --git a/testsuite/tests/deriving/should_compile/T11509_2.hs b/testsuite/tests/deriving/should_compile/T11509_2.hs new file mode 100644 index 0000000000..3071755db2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T11509_2.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} +module T11509_2 where + +import GHC.Exts (Constraint) + +class C1 (a :: Constraint) where +class C2 where + +deriving instance C1 C2 diff --git a/testsuite/tests/deriving/should_compile/T11509_3.hs b/testsuite/tests/deriving/should_compile/T11509_3.hs new file mode 100644 index 0000000000..c9e7263a2b --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T11509_3.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE StandaloneDeriving #-} +module T11509_3 where + +import System.IO (Handle) -- A data type whose constructors are hidden + +class C a where + +deriving instance C Handle diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 1b4c8b36ad..26312df3e9 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -66,6 +66,8 @@ test('T11174', normal, compile, ['']) test('T11416', normal, compile, ['']) test('T11396', normal, compile, ['']) test('T11357', normal, compile, ['']) +test('T11509_2', expect_fail, compile, ['']) +test('T11509_3', normal, compile, ['']) test('T11732a', normal, compile, ['']) test('T11732b', normal, compile, ['']) test('T11732c', normal, compile, ['']) diff --git a/testsuite/tests/deriving/should_fail/T11509_1.hs b/testsuite/tests/deriving/should_fail/T11509_1.hs new file mode 100644 index 0000000000..369f51ad39 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T11509_1.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE StaticPointers #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} +module T11509 where + +import Data.Kind +import Data.Typeable +import GHC.StaticPtr + +{------------------------------------------------------------------------------- + Standard Cloud-Haskell-like infrastructure + + See <https://ghc.haskell.org/trac/ghc/wiki/TypeableT> for a dicussion of 'SC'. +-------------------------------------------------------------------------------} + +class Serializable a -- empty class, just for demonstration purposes + +instance Serializable a => Serializable [a] + +data Static :: * -> * where + StaticPtr :: StaticPtr a -> Static a + StaticApp :: Static (a -> b) -> Static a -> Static b + +staticApp :: StaticPtr (a -> b) -> Static a -> Static b +staticApp = StaticApp . StaticPtr + +data Dict :: Constraint -> * where + Dict :: c => Dict c + +class c => SC c where + dict :: Static (Dict c) + +instance (Typeable a, SC (Serializable a)) => SC (Serializable [a]) where + dict = aux `staticApp` dict + where + aux :: StaticPtr (Dict (Serializable a) -> Dict (Serializable [a])) + aux = static (\Dict -> Dict) + +{------------------------------------------------------------------------------- + Demonstrate the bug +-------------------------------------------------------------------------------} + +newtype MyList a = MyList [a] + +deriving instance (Typeable a, SC (Serializable a)) => SC (Serializable (MyList a)) diff --git a/testsuite/tests/deriving/should_fail/T11509_1.stderr b/testsuite/tests/deriving/should_fail/T11509_1.stderr new file mode 100644 index 0000000000..a50310e50b --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T11509_1.stderr @@ -0,0 +1,7 @@ + +T11509_1.hs:52:1: error: + • Can't make a derived instance of ‘SC (Serializable (MyList a))’: + ‘Serializable’ is a type class, and can only have a derived instance + if DeriveAnyClass is enabled + • In the stand-alone deriving instance for + ‘(Typeable a, SC (Serializable a)) => SC (Serializable (MyList a))’ diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index ce0cc0f155..5fec71eff5 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -64,5 +64,7 @@ test('T10598_fail3', normal, compile_fail, ['']) test('T10598_fail4', normal, compile_fail, ['']) test('T10598_fail5', normal, compile_fail, ['']) test('T10598_fail6', normal, compile_fail, ['']) +test('T11509_1', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], + compile_fail, ['']) test('T12163', normal, compile_fail, ['']) test('T12512', omit_ways(['ghci']), compile_fail, ['']) |