summaryrefslogtreecommitdiff
path: root/testsuite/tests/deriving/should_compile
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/deriving/should_compile')
-rw-r--r--testsuite/tests/deriving/should_compile/T13154b.hs62
-rw-r--r--testsuite/tests/deriving/should_compile/all.T1
2 files changed, 63 insertions, 0 deletions
diff --git a/testsuite/tests/deriving/should_compile/T13154b.hs b/testsuite/tests/deriving/should_compile/T13154b.hs
new file mode 100644
index 0000000000..9df828b111
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T13154b.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnboxedSums #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
+module T13154b where
+
+import Data.Kind
+import Data.Typeable
+import GHC.Exts
+import GHC.TypeLits
+
+class Foo1 (a :: TYPE ('TupleRep '[]))
+deriving instance Foo1 a
+
+class Foo2 (a :: TYPE ('TupleRep '[]))
+deriving instance Foo2 (##)
+
+class Foo3 (a :: TYPE ('SumRep '[ 'LiftedRep, 'LiftedRep ]))
+deriving instance Foo3 a
+
+class Foo4 (a :: TYPE ('SumRep '[ 'LiftedRep, 'LiftedRep ]))
+deriving instance Foo4 (# a | b #)
+
+class Foo5 (a :: Type)
+deriving instance Foo5 a
+
+class Foo6
+deriving instance Foo6
+
+class Foo7 (a :: Nat)
+deriving anyclass instance Foo7 0
+deriving instance Foo7 1
+
+class Foo8 (a :: Symbol)
+deriving anyclass instance Foo8 "a"
+deriving instance Foo8 "b"
+
+class Typeable a => Foo9 a
+deriving instance _ => Foo9 (f a)
+
+data family D1 a
+newtype ByBar a = ByBar a
+class Foo10 a where
+ baz :: a -> a
+instance Foo10 (ByBar a) where
+ baz = id
+deriving via ByBar (D1 a) instance Foo10 (D1 a)
+
+data family D2
+data family D3
+class Foo11 a where
+deriving anyclass instance Foo11 D2
+deriving instance Foo11 D3
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index 55c7d90f09..e29ae0e0b5 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -89,6 +89,7 @@ test('T12616', normal, compile, [''])
test('T12688', normal, compile, [''])
test('T12814', normal, compile, ['-Wredundant-constraints'])
test('T13154a', normal, compile, [''])
+test('T13154b', normal, compile, [''])
test('T13272', normal, compile, [''])
test('T13272a', normal, compile, [''])
test('T13297', normal, compile, [''])