From 1e3ca733694f0c9c8cc1d95237eb4b09cee4206f Mon Sep 17 00:00:00 2001 From: Richard Eisenberg Date: Wed, 28 Aug 2013 12:05:03 -0400 Subject: Update to tests due to change in syntax for role annotations. --- testsuite/tests/roles/Makefile | 3 ++ testsuite/tests/roles/should_compile/Makefile | 3 ++ testsuite/tests/roles/should_compile/Roles1.hs | 18 +++++++ testsuite/tests/roles/should_compile/Roles1.stderr | 57 ++++++++++++++++++++++ testsuite/tests/roles/should_compile/Roles13.hs | 12 +++++ .../tests/roles/should_compile/Roles13.stderr | 20 ++++++++ testsuite/tests/roles/should_compile/Roles2.hs | 9 ++++ testsuite/tests/roles/should_compile/Roles2.stderr | 22 +++++++++ testsuite/tests/roles/should_compile/Roles3.hs | 21 ++++++++ testsuite/tests/roles/should_compile/Roles3.stderr | 39 +++++++++++++++ testsuite/tests/roles/should_compile/Roles4.hs | 17 +++++++ testsuite/tests/roles/should_compile/Roles4.stderr | 28 +++++++++++ testsuite/tests/roles/should_compile/all.T | 5 ++ testsuite/tests/roles/should_fail/Makefile | 9 ++++ testsuite/tests/roles/should_fail/Roles10.hs | 16 ++++++ testsuite/tests/roles/should_fail/Roles10.stderr | 7 +++ testsuite/tests/roles/should_fail/Roles11.hs | 8 +++ testsuite/tests/roles/should_fail/Roles11.stderr | 5 ++ testsuite/tests/roles/should_fail/Roles12.hs | 5 ++ testsuite/tests/roles/should_fail/Roles12.hs-boot | 3 ++ testsuite/tests/roles/should_fail/Roles12.stderr | 15 ++++++ testsuite/tests/roles/should_fail/Roles5.hs | 9 ++++ testsuite/tests/roles/should_fail/Roles5.stderr | 12 +++++ testsuite/tests/roles/should_fail/Roles6.hs | 8 +++ testsuite/tests/roles/should_fail/Roles6.stderr | 15 ++++++ testsuite/tests/roles/should_fail/Roles7.hs | 7 +++ testsuite/tests/roles/should_fail/Roles7.stderr | 4 ++ testsuite/tests/roles/should_fail/Roles8.hs | 13 +++++ testsuite/tests/roles/should_fail/Roles8.stderr | 10 ++++ testsuite/tests/roles/should_fail/Roles9.hs | 13 +++++ testsuite/tests/roles/should_fail/Roles9.stderr | 7 +++ testsuite/tests/roles/should_fail/all.T | 10 ++++ 32 files changed, 430 insertions(+) create mode 100644 testsuite/tests/roles/Makefile create mode 100644 testsuite/tests/roles/should_compile/Makefile create mode 100644 testsuite/tests/roles/should_compile/Roles1.hs create mode 100644 testsuite/tests/roles/should_compile/Roles1.stderr create mode 100644 testsuite/tests/roles/should_compile/Roles13.hs create mode 100644 testsuite/tests/roles/should_compile/Roles13.stderr create mode 100644 testsuite/tests/roles/should_compile/Roles2.hs create mode 100644 testsuite/tests/roles/should_compile/Roles2.stderr create mode 100644 testsuite/tests/roles/should_compile/Roles3.hs create mode 100644 testsuite/tests/roles/should_compile/Roles3.stderr create mode 100644 testsuite/tests/roles/should_compile/Roles4.hs create mode 100644 testsuite/tests/roles/should_compile/Roles4.stderr create mode 100644 testsuite/tests/roles/should_compile/all.T create mode 100644 testsuite/tests/roles/should_fail/Makefile create mode 100644 testsuite/tests/roles/should_fail/Roles10.hs create mode 100644 testsuite/tests/roles/should_fail/Roles10.stderr create mode 100644 testsuite/tests/roles/should_fail/Roles11.hs create mode 100644 testsuite/tests/roles/should_fail/Roles11.stderr create mode 100644 testsuite/tests/roles/should_fail/Roles12.hs create mode 100644 testsuite/tests/roles/should_fail/Roles12.hs-boot create mode 100644 testsuite/tests/roles/should_fail/Roles12.stderr create mode 100644 testsuite/tests/roles/should_fail/Roles5.hs create mode 100644 testsuite/tests/roles/should_fail/Roles5.stderr create mode 100644 testsuite/tests/roles/should_fail/Roles6.hs create mode 100644 testsuite/tests/roles/should_fail/Roles6.stderr create mode 100644 testsuite/tests/roles/should_fail/Roles7.hs create mode 100644 testsuite/tests/roles/should_fail/Roles7.stderr create mode 100644 testsuite/tests/roles/should_fail/Roles8.hs create mode 100644 testsuite/tests/roles/should_fail/Roles8.stderr create mode 100644 testsuite/tests/roles/should_fail/Roles9.hs create mode 100644 testsuite/tests/roles/should_fail/Roles9.stderr create mode 100644 testsuite/tests/roles/should_fail/all.T (limited to 'testsuite/tests/roles') diff --git a/testsuite/tests/roles/Makefile b/testsuite/tests/roles/Makefile new file mode 100644 index 0000000000..9a36a1c5fe --- /dev/null +++ b/testsuite/tests/roles/Makefile @@ -0,0 +1,3 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/roles/should_compile/Makefile b/testsuite/tests/roles/should_compile/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/roles/should_compile/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/roles/should_compile/Roles1.hs b/testsuite/tests/roles/should_compile/Roles1.hs new file mode 100644 index 0000000000..ca040c4353 --- /dev/null +++ b/testsuite/tests/roles/should_compile/Roles1.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE RoleAnnotations, PolyKinds #-} + +module Roles1 where + +data T1 a = K1 a +data T2 a = K2 a +data T3 (a :: k) = K3 +data T4 (a :: * -> *) b = K4 (a b) + +data T5 a = K5 a +data T6 a = K6 +data T7 a b = K7 b + +type role T1 nominal +type role T2 representational +type role T3 phantom +type role T4 nominal _ +type role T5 _ \ No newline at end of file diff --git a/testsuite/tests/roles/should_compile/Roles1.stderr b/testsuite/tests/roles/should_compile/Roles1.stderr new file mode 100644 index 0000000000..e56cfb44b3 --- /dev/null +++ b/testsuite/tests/roles/should_compile/Roles1.stderr @@ -0,0 +1,57 @@ +TYPE SIGNATURES +TYPE CONSTRUCTORS + T1 :: * -> * + data T1 a + No C type associated + Roles: [nominal] + RecFlag NonRecursive, Promotable + = K1 :: forall a. a -> T1 a Stricts: _ + FamilyInstance: none + T2 :: * -> * + data T2 a + No C type associated + Roles: [representational] + RecFlag NonRecursive, Promotable + = K2 :: forall a. a -> T2 a Stricts: _ + FamilyInstance: none + T3 :: forall (k :: BOX). k -> * + data T3 (k::BOX) (a::k) + No C type associated + Roles: [nominal, phantom] + RecFlag NonRecursive, Not promotable + = K3 :: forall (k::BOX) (a::k). T3 k a + FamilyInstance: none + T4 :: (* -> *) -> * -> * + data T4 (a::* -> *) b + No C type associated + Roles: [nominal, nominal] + RecFlag NonRecursive, Not promotable + = K4 :: forall (a::* -> *) b. (a b) -> T4 a b Stricts: _ + FamilyInstance: none + T5 :: * -> * + data T5 a + No C type associated + Roles: [representational] + RecFlag NonRecursive, Promotable + = K5 :: forall a. a -> T5 a Stricts: _ + FamilyInstance: none + T6 :: forall (k :: BOX). k -> * + data T6 (k::BOX) (a::k) + No C type associated + Roles: [nominal, phantom] + RecFlag NonRecursive, Not promotable + = K6 :: forall (k::BOX) (a::k). T6 k a + FamilyInstance: none + T7 :: forall (k :: BOX). k -> * -> * + data T7 (k::BOX) (a::k) b + No C type associated + Roles: [nominal, phantom, representational] + 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/roles/should_compile/Roles13.hs b/testsuite/tests/roles/should_compile/Roles13.hs new file mode 100644 index 0000000000..70d4c0c7d0 --- /dev/null +++ b/testsuite/tests/roles/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/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr new file mode 100644 index 0000000000..647e59ba51 --- /dev/null +++ b/testsuite/tests/roles/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` (_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/roles/should_compile/Roles2.hs b/testsuite/tests/roles/should_compile/Roles2.hs new file mode 100644 index 0000000000..1ead5a4e94 --- /dev/null +++ b/testsuite/tests/roles/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/roles/should_compile/Roles2.stderr b/testsuite/tests/roles/should_compile/Roles2.stderr new file mode 100644 index 0000000000..ac7a94bbfa --- /dev/null +++ b/testsuite/tests/roles/should_compile/Roles2.stderr @@ -0,0 +1,22 @@ +TYPE SIGNATURES +TYPE CONSTRUCTORS + T1 :: * -> * + data T1 a + No C type associated + Roles: [representational] + RecFlag NonRecursive, Not promotable + = K1 :: forall a. (IO a) -> T1 a Stricts: _ + FamilyInstance: none + T2 :: * -> * + data T2 a + No C type associated + Roles: [representational] + 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/roles/should_compile/Roles3.hs b/testsuite/tests/roles/should_compile/Roles3.hs new file mode 100644 index 0000000000..4c26f0d986 --- /dev/null +++ b/testsuite/tests/roles/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/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr new file mode 100644 index 0000000000..5a074179db --- /dev/null +++ b/testsuite/tests/roles/should_compile/Roles3.stderr @@ -0,0 +1,39 @@ +TYPE SIGNATURES +TYPE CONSTRUCTORS + C1 :: * -> Constraint + class C1 a + Roles: [representational] + RecFlag NonRecursive + meth1 :: a -> a + C2 :: * -> * -> Constraint + class C2 a b + Roles: [nominal, nominal] + RecFlag NonRecursive + meth2 :: (~) * a b -> a -> b + C3 :: * -> * -> Constraint + class C3 a b + Roles: [representational, nominal] + RecFlag NonRecursive + type family F3 b :: * + meth3 :: a -> F3 b -> F3 b + C4 :: * -> * -> Constraint + class C4 a b + Roles: [representational, nominal] + RecFlag NonRecursive + meth4 :: a -> F4 b -> F4 b + F4 :: * -> * + type family F4 a :: * + Syn1 :: * -> * + type Syn1 a = F4 a + Syn2 :: * -> * + type Syn2 a = [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/roles/should_compile/Roles4.hs b/testsuite/tests/roles/should_compile/Roles4.hs new file mode 100644 index 0000000000..b5c404a84c --- /dev/null +++ b/testsuite/tests/roles/should_compile/Roles4.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE RoleAnnotations #-} + +module Roles4 where + +type role C1 nominal +class C1 a where + meth1 :: a -> a + +type role C2 representational +class C2 a where + meth2 :: a -> a + +type Syn1 a = [a] + +class C3 a where + meth3 :: a -> Syn1 a + diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr new file mode 100644 index 0000000000..5da8f04b26 --- /dev/null +++ b/testsuite/tests/roles/should_compile/Roles4.stderr @@ -0,0 +1,28 @@ +TYPE SIGNATURES +TYPE CONSTRUCTORS + C1 :: * -> Constraint + class C1 a + Roles: [nominal] + RecFlag NonRecursive + meth1 :: a -> a + C2 :: * -> Constraint + class C2 a + Roles: [representational] + RecFlag NonRecursive + meth2 :: a -> a + C3 :: * -> Constraint + class C3 a + Roles: [representational] + RecFlag NonRecursive + meth3 :: a -> Syn1 a + Syn1 :: * -> * + type Syn1 a = [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/roles/should_compile/all.T b/testsuite/tests/roles/should_compile/all.T new file mode 100644 index 0000000000..eaa398d619 --- /dev/null +++ b/testsuite/tests/roles/should_compile/all.T @@ -0,0 +1,5 @@ +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']) diff --git a/testsuite/tests/roles/should_fail/Makefile b/testsuite/tests/roles/should_fail/Makefile new file mode 100644 index 0000000000..8f80de39c3 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Makefile @@ -0,0 +1,9 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +.PHONY: Roles12 + +Roles12: + '$(TEST_HC)' $(TEST_HC_OPTS) -c Roles12.hs-boot + -'$(TEST_HC)' $(TEST_HC_OPTS) -c Roles12.hs diff --git a/testsuite/tests/roles/should_fail/Roles10.hs b/testsuite/tests/roles/should_fail/Roles10.hs new file mode 100644 index 0000000000..af19bfdf31 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles10.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-} + +module Roles10 where + +type family F a +type instance F Int = Bool +type instance F Age = Char + +class C a where + meth :: a -> F a + +instance C Int where + meth = (> 0) + +newtype Age = MkAge Int + deriving C \ No newline at end of file diff --git a/testsuite/tests/roles/should_fail/Roles10.stderr b/testsuite/tests/roles/should_fail/Roles10.stderr new file mode 100644 index 0000000000..756aaa2e00 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles10.stderr @@ -0,0 +1,7 @@ + +Roles10.hs:16:12: + Can't make a derived instance of ‛C Age’ + (even with cunning newtype deriving): + it is not type-safe to use GeneralizedNewtypeDeriving on this class; + the last parameter of ‛C’ is at role Nominal + In the newtype declaration for ‛Age’ diff --git a/testsuite/tests/roles/should_fail/Roles11.hs b/testsuite/tests/roles/should_fail/Roles11.hs new file mode 100644 index 0000000000..bc05477da9 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles11.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs, RoleAnnotations #-} + +module Roles11 where + +type role T2 representational +data T2 a where + K2 :: T2 Int + diff --git a/testsuite/tests/roles/should_fail/Roles11.stderr b/testsuite/tests/roles/should_fail/Roles11.stderr new file mode 100644 index 0000000000..ee15f99185 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles11.stderr @@ -0,0 +1,5 @@ + +Roles11.hs:6:1: + Role mismatch on variable a: + Annotation says representational but role nominal is required + In the data declaration for ‛T2’ diff --git a/testsuite/tests/roles/should_fail/Roles12.hs b/testsuite/tests/roles/should_fail/Roles12.hs new file mode 100644 index 0000000000..875d105b78 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles12.hs @@ -0,0 +1,5 @@ +module Roles12 where + +import {-# SOURCE #-} Roles12 + +data T a diff --git a/testsuite/tests/roles/should_fail/Roles12.hs-boot b/testsuite/tests/roles/should_fail/Roles12.hs-boot new file mode 100644 index 0000000000..6a708d984a --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles12.hs-boot @@ -0,0 +1,3 @@ +module Roles12 where + +data T a \ No newline at end of file diff --git a/testsuite/tests/roles/should_fail/Roles12.stderr b/testsuite/tests/roles/should_fail/Roles12.stderr new file mode 100644 index 0000000000..42d63463e0 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles12.stderr @@ -0,0 +1,15 @@ + +Roles12.hs:5:6: + Type constructor ‛T’ has conflicting definitions in the module + and its hs-boot file + Main module: data T a + No C type associated + Roles: [phantom] + RecFlag Recursive, Promotable + = + FamilyInstance: none + Boot file: abstract(False) T a + No C type associated + Roles: [representational] + RecFlag NonRecursive, Not promotable + FamilyInstance: none diff --git a/testsuite/tests/roles/should_fail/Roles5.hs b/testsuite/tests/roles/should_fail/Roles5.hs new file mode 100644 index 0000000000..b75af75008 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles5.hs @@ -0,0 +1,9 @@ +module Roles5 where + +data T a +class C a +type S a = Int + +type role T nominal +type role C representational +type role S phantom \ No newline at end of file diff --git a/testsuite/tests/roles/should_fail/Roles5.stderr b/testsuite/tests/roles/should_fail/Roles5.stderr new file mode 100644 index 0000000000..c4907c89f6 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles5.stderr @@ -0,0 +1,12 @@ + +Roles5.hs:7:1: + Illegal role annotation for T; + did you intend to use RoleAnnotations? + +Roles5.hs:8:1: + Illegal role annotation for C; + did you intend to use RoleAnnotations? + +Roles5.hs:9:1: + Illegal role annotation for S; + they are allowed only for datatypes and classes. diff --git a/testsuite/tests/roles/should_fail/Roles6.hs b/testsuite/tests/roles/should_fail/Roles6.hs new file mode 100644 index 0000000000..c0ab9fafb2 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles6.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE RoleAnnotations #-} + +module Roles6 where + +data Foo a b = MkFoo (a b) + +type role Foo nominal representational phantom + diff --git a/testsuite/tests/roles/should_fail/Roles6.stderr b/testsuite/tests/roles/should_fail/Roles6.stderr new file mode 100644 index 0000000000..3cca04d2a6 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles6.stderr @@ -0,0 +1,15 @@ + +Roles6.hs:5:1: + Role mismatch on variable a: + Annotation says nominal but role representational is required + In the data declaration for ‛Foo’ + +Roles6.hs:5:1: + Role mismatch on variable b: + Annotation says representational but role nominal is required + In the data declaration for ‛Foo’ + +Roles6.hs:7:1: + Wrong number of roles listed in role annotation; + Expected 2, got 3: + type role Foo nominal representational phantom diff --git a/testsuite/tests/roles/should_fail/Roles7.hs b/testsuite/tests/roles/should_fail/Roles7.hs new file mode 100644 index 0000000000..221b01a1c5 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles7.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RoleAnnotations #-} + +module Roles7 where + +class Bar a +type role Bar repesentational + -- spelling error intentional! \ No newline at end of file diff --git a/testsuite/tests/roles/should_fail/Roles7.stderr b/testsuite/tests/roles/should_fail/Roles7.stderr new file mode 100644 index 0000000000..e4774f1aa8 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles7.stderr @@ -0,0 +1,4 @@ + +Roles7.hs:6:15: + Illegal role name ‛repesentational’ + Perhaps you meant ‛representational’ diff --git a/testsuite/tests/roles/should_fail/Roles8.hs b/testsuite/tests/roles/should_fail/Roles8.hs new file mode 100644 index 0000000000..396431cd50 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles8.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE RoleAnnotations, GADTs #-} + +module Roles8 where + +data T1 a = K1 a + +type role T1 nominal +type role T1 nominal + +data T2 b = MkT2 + +type role T2 representational +type role T2 phantom \ No newline at end of file diff --git a/testsuite/tests/roles/should_fail/Roles8.stderr b/testsuite/tests/roles/should_fail/Roles8.stderr new file mode 100644 index 0000000000..22f66f4667 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles8.stderr @@ -0,0 +1,10 @@ + +Roles8.hs:7:1: + Duplicate role annotations for ‛T1’: + type role T1 nominal -- written at Roles8.hs:7:1-20 + type role T1 nominal -- written at Roles8.hs:8:1-20 + +Roles8.hs:12:1: + Duplicate role annotations for ‛T2’: + type role T2 representational -- written at Roles8.hs:12:1-29 + type role T2 phantom -- written at Roles8.hs:13:1-20 diff --git a/testsuite/tests/roles/should_fail/Roles9.hs b/testsuite/tests/roles/should_fail/Roles9.hs new file mode 100644 index 0000000000..f8e134d5a1 --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles9.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, RoleAnnotations #-} + +module Roles9 where + +type role C nominal +class C a where + meth :: a -> a + +instance C Int where + meth = (+ 1) + +newtype Age = MkAge Int + deriving C diff --git a/testsuite/tests/roles/should_fail/Roles9.stderr b/testsuite/tests/roles/should_fail/Roles9.stderr new file mode 100644 index 0000000000..0cd02f9b5f --- /dev/null +++ b/testsuite/tests/roles/should_fail/Roles9.stderr @@ -0,0 +1,7 @@ + +Roles9.hs:13:12: + Can't make a derived instance of ‛C Age’ + (even with cunning newtype deriving): + it is not type-safe to use GeneralizedNewtypeDeriving on this class; + the last parameter of ‛C’ is at role Nominal + In the newtype declaration for ‛Age’ diff --git a/testsuite/tests/roles/should_fail/all.T b/testsuite/tests/roles/should_fail/all.T new file mode 100644 index 0000000000..36f2d2e1a4 --- /dev/null +++ b/testsuite/tests/roles/should_fail/all.T @@ -0,0 +1,10 @@ +test('Roles5', normal, compile_fail, ['']) +test('Roles6', normal, compile_fail, ['']) +test('Roles7', normal, compile_fail, ['']) +test('Roles8', normal, compile_fail, ['']) +test('Roles9', normal, compile_fail, ['']) +test('Roles10', normal, compile_fail, ['']) +test('Roles11', normal, compile_fail, ['']) +test('Roles12', + extra_clean(['Roles12.o-boot', 'Roles12.hi-boot']), + run_command, ['$MAKE --no-print-directory -s Roles12']) -- cgit v1.2.1