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/Roles1.hs13
-rw-r--r--testsuite/tests/deriving/should_compile/Roles1.stderr50
-rw-r--r--testsuite/tests/deriving/should_compile/Roles13.hs12
-rw-r--r--testsuite/tests/deriving/should_compile/Roles13.stderr20
-rw-r--r--testsuite/tests/deriving/should_compile/Roles2.hs9
-rw-r--r--testsuite/tests/deriving/should_compile/Roles2.stderr20
-rw-r--r--testsuite/tests/deriving/should_compile/Roles3.hs21
-rw-r--r--testsuite/tests/deriving/should_compile/Roles3.stderr35
-rw-r--r--testsuite/tests/deriving/should_compile/Roles4.hs15
-rw-r--r--testsuite/tests/deriving/should_compile/Roles4.stderr25
-rw-r--r--testsuite/tests/deriving/should_compile/all.T8
11 files changed, 227 insertions, 1 deletions
diff --git a/testsuite/tests/deriving/should_compile/Roles1.hs b/testsuite/tests/deriving/should_compile/Roles1.hs
new file mode 100644
index 0000000000..d0467c1a90
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/Roles1.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE RoleAnnotations, PolyKinds #-}
+
+module Roles1 where
+
+data T1 a@N = K1 a
+data T2 a@R = K2 a
+data T3 (a :: k)@P = K3
+data T4 (a :: * -> *)@N b = K4 (a b)
+
+data T5 a = K5 a
+data T6 a = K6
+data T7 a b = K7 b
+
diff --git a/testsuite/tests/deriving/should_compile/Roles1.stderr b/testsuite/tests/deriving/should_compile/Roles1.stderr
new file mode 100644
index 0000000000..10edab13ef
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/Roles1.stderr
@@ -0,0 +1,50 @@
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+ T1 :: * -> *
+ data T1 a@N
+ No C type associated
+ RecFlag NonRecursive, Promotable
+ = K1 :: forall a. a -> T1 a Stricts: _
+ FamilyInstance: none
+ T2 :: * -> *
+ data T2 a@R
+ No C type associated
+ RecFlag NonRecursive, Promotable
+ = K2 :: forall a. a -> T2 a Stricts: _
+ FamilyInstance: none
+ T3 :: forall (k :: BOX). k -> *
+ data T3 (k::BOX)@N (a::k)@P
+ No C type associated
+ RecFlag NonRecursive, Not promotable
+ = K3 :: forall (k::BOX) (a::k). T3 k a
+ FamilyInstance: none
+ T4 :: (* -> *) -> * -> *
+ data T4 (a::* -> *)@N b@N
+ No C type associated
+ RecFlag NonRecursive, Not promotable
+ = K4 :: forall (a::* -> *) b. (a b) -> T4 a b Stricts: _
+ FamilyInstance: none
+ T5 :: * -> *
+ data T5 a@R
+ No C type associated
+ RecFlag NonRecursive, Promotable
+ = K5 :: forall a. a -> T5 a Stricts: _
+ FamilyInstance: none
+ T6 :: forall (k :: BOX). k -> *
+ data T6 (k::BOX)@N (a::k)@P
+ No C type associated
+ RecFlag NonRecursive, Not promotable
+ = K6 :: forall (k::BOX) (a::k). T6 k a
+ FamilyInstance: none
+ T7 :: forall (k :: BOX). k -> * -> *
+ data T7 (k::BOX)@N (a::k)@P b@R
+ No C type associated
+ RecFlag NonRecursive, Not promotable
+ = K7 :: forall (k::BOX) (a::k) b. b -> T7 k a b Stricts: _
+ FamilyInstance: none
+COERCION AXIOMS
+Dependent modules: []
+Dependent packages: [base, ghc-prim, integer-gmp]
+
+==================== Typechecker ====================
+
diff --git a/testsuite/tests/deriving/should_compile/Roles13.hs b/testsuite/tests/deriving/should_compile/Roles13.hs
new file mode 100644
index 0000000000..70d4c0c7d0
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/Roles13.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving,
+ MultiParamTypeClasses, FunctionalDependencies #-}
+
+-- tests axiom roles
+
+module Roles13 where
+
+newtype Age = MkAge Int
+newtype Wrap a = MkWrap a
+
+convert :: Wrap Age -> Int
+convert (MkWrap (MkAge i)) = i
diff --git a/testsuite/tests/deriving/should_compile/Roles13.stderr b/testsuite/tests/deriving/should_compile/Roles13.stderr
new file mode 100644
index 0000000000..647e59ba51
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/Roles13.stderr
@@ -0,0 +1,20 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core = {terms: 5, types: 9, coercions: 5}
+
+a :: Roles13.Wrap Roles13.Age -> Roles13.Wrap Roles13.Age
+[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType]
+a = \ (ds :: Roles13.Wrap Roles13.Age) -> ds
+
+Roles13.convert :: Roles13.Wrap Roles13.Age -> GHC.Types.Int
+[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType]
+Roles13.convert =
+ a
+ `cast` (<Roles13.Wrap Roles13.Age>_R
+ -> Roles13.NTCo:Wrap[0] Roles13.NTCo:Age[0]
+ :: (Roles13.Wrap Roles13.Age -> Roles13.Wrap Roles13.Age)
+ ~#
+ (Roles13.Wrap Roles13.Age -> GHC.Types.Int))
+
+
+
diff --git a/testsuite/tests/deriving/should_compile/Roles2.hs b/testsuite/tests/deriving/should_compile/Roles2.hs
new file mode 100644
index 0000000000..1ead5a4e94
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/Roles2.hs
@@ -0,0 +1,9 @@
+module Roles2 where
+
+import GHC.Ptr
+
+-- these *must* have certain roles, or things break strangely
+-- see TcForeign
+
+data T1 a = K1 (IO a)
+data T2 a = K2 (FunPtr a)
diff --git a/testsuite/tests/deriving/should_compile/Roles2.stderr b/testsuite/tests/deriving/should_compile/Roles2.stderr
new file mode 100644
index 0000000000..2dcf28e3bf
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/Roles2.stderr
@@ -0,0 +1,20 @@
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+ T1 :: * -> *
+ data T1 a@R
+ No C type associated
+ RecFlag NonRecursive, Not promotable
+ = K1 :: forall a. (IO a) -> T1 a Stricts: _
+ FamilyInstance: none
+ T2 :: * -> *
+ data T2 a@R
+ No C type associated
+ RecFlag NonRecursive, Not promotable
+ = K2 :: forall a. (FunPtr a) -> T2 a Stricts: _
+ FamilyInstance: none
+COERCION AXIOMS
+Dependent modules: []
+Dependent packages: [base, ghc-prim, integer-gmp]
+
+==================== Typechecker ====================
+
diff --git a/testsuite/tests/deriving/should_compile/Roles3.hs b/testsuite/tests/deriving/should_compile/Roles3.hs
new file mode 100644
index 0000000000..4c26f0d986
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/Roles3.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}
+
+module Roles3 where
+
+class C1 a where
+ meth1 :: a -> a
+
+class C2 a b where
+ meth2 :: a ~ b => a -> b
+
+class C3 a b where
+ type F3 b
+ meth3 :: a -> F3 b -> F3 b
+
+type family F4 a
+
+class C4 a b where
+ meth4 :: a -> F4 b -> F4 b
+
+type Syn1 a = F4 a
+type Syn2 a = [a] \ No newline at end of file
diff --git a/testsuite/tests/deriving/should_compile/Roles3.stderr b/testsuite/tests/deriving/should_compile/Roles3.stderr
new file mode 100644
index 0000000000..1b187f4907
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/Roles3.stderr
@@ -0,0 +1,35 @@
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+ C1 :: * -> Constraint
+ class C1 a@R
+ RecFlag NonRecursive
+ meth1 :: a -> a
+ C2 :: * -> * -> Constraint
+ class C2 a@N b@N
+ RecFlag NonRecursive
+ meth2 :: (~) * a b -> a -> b
+ C3 :: * -> * -> Constraint
+ class C3 a@R b@N
+ RecFlag NonRecursive
+ type family F3 b@N :: *
+ meth3 :: a -> F3 b -> F3 b
+ C4 :: * -> * -> Constraint
+ class C4 a@R b@N
+ RecFlag NonRecursive
+ meth4 :: a -> F4 b -> F4 b
+ F4 :: * -> *
+ type family F4 a@N :: *
+ Syn1 :: * -> *
+ type Syn1 a@N = F4 a
+ Syn2 :: * -> *
+ type Syn2 a@R = [a]
+COERCION AXIOMS
+ axiom Roles3.NTCo:C1 :: C1 a = a -> a
+ axiom Roles3.NTCo:C2 :: C2 a b = a ~ b => a -> b
+ axiom Roles3.NTCo:C3 :: C3 a b = a -> F3 b -> F3 b
+ axiom Roles3.NTCo:C4 :: C4 a b = a -> F4 b -> F4 b
+Dependent modules: []
+Dependent packages: [base, ghc-prim, integer-gmp]
+
+==================== Typechecker ====================
+
diff --git a/testsuite/tests/deriving/should_compile/Roles4.hs b/testsuite/tests/deriving/should_compile/Roles4.hs
new file mode 100644
index 0000000000..32cb65a7df
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/Roles4.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE RoleAnnotations #-}
+
+module Roles4 where
+
+class C1 a@N where
+ meth1 :: a -> a
+
+class C2 a@R where
+ meth2 :: a -> a
+
+type Syn1 a@N = [a]
+
+class C3 a where
+ meth3 :: a -> Syn1 a
+
diff --git a/testsuite/tests/deriving/should_compile/Roles4.stderr b/testsuite/tests/deriving/should_compile/Roles4.stderr
new file mode 100644
index 0000000000..9969cbca12
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/Roles4.stderr
@@ -0,0 +1,25 @@
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+ C1 :: * -> Constraint
+ class C1 a@N
+ RecFlag NonRecursive
+ meth1 :: a -> a
+ C2 :: * -> Constraint
+ class C2 a@R
+ RecFlag NonRecursive
+ meth2 :: a -> a
+ C3 :: * -> Constraint
+ class C3 a@N
+ RecFlag NonRecursive
+ meth3 :: a -> Syn1 a
+ Syn1 :: * -> *
+ type Syn1 a@N = [a]
+COERCION AXIOMS
+ axiom Roles4.NTCo:C1 :: C1 a = a -> a
+ axiom Roles4.NTCo:C2 :: C2 a = a -> a
+ axiom Roles4.NTCo:C3 :: C3 a = a -> Syn1 a
+Dependent modules: []
+Dependent packages: [base, ghc-prim, integer-gmp]
+
+==================== Typechecker ====================
+
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index 07df602a20..e8fa8fe88d 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -39,4 +39,10 @@ test('T1133',
test('T7704', normal, compile, [''])
test('T7710', normal, compile, [''])
-test('AutoDeriveTypeable', normal, compile, ['']) \ No newline at end of file
+test('AutoDeriveTypeable', normal, compile, [''])
+
+test('Roles1', only_ways('normal'), compile, ['-ddump-tc'])
+test('Roles2', only_ways('normal'), compile, ['-ddump-tc'])
+test('Roles3', only_ways('normal'), compile, ['-ddump-tc'])
+test('Roles4', only_ways('normal'), compile, ['-ddump-tc'])
+test('Roles13', only_ways('normal'), compile, ['-ddump-simpl -dsuppress-uniques']) \ No newline at end of file