diff options
Diffstat (limited to 'testsuite/tests/deriving/should_compile')
-rw-r--r-- | testsuite/tests/deriving/should_compile/Roles1.hs | 13 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/Roles1.stderr | 50 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/Roles13.hs | 12 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/Roles13.stderr | 20 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/Roles2.hs | 9 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/Roles2.stderr | 20 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/Roles3.hs | 21 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/Roles3.stderr | 35 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/Roles4.hs | 15 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/Roles4.stderr | 25 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/all.T | 8 |
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 |