summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorRichard Eisenberg <eir@cis.upenn.edu>2013-08-02 15:50:51 +0100
committerRichard Eisenberg <eir@cis.upenn.edu>2013-08-02 15:50:51 +0100
commit929155faa511569eb626d49a32264442c5caa14f (patch)
tree0197b1b0e5144206099f749c4eb8659ad05c8766 /testsuite
parent5207c0ff005e579ba634d6b1aa248c825e957014 (diff)
downloadhaskell-929155faa511569eb626d49a32264442c5caa14f.tar.gz
Add tests for roles.
Many of the files modified are just wibbles to output, because now tycons have roles attached to them, which are produced in the debugging dumps.
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/deSugar/should_compile/T2431.stderr4
-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
-rw-r--r--testsuite/tests/deriving/should_fail/Makefile5
-rw-r--r--testsuite/tests/deriving/should_fail/Roles10.hs16
-rw-r--r--testsuite/tests/deriving/should_fail/Roles10.stderr7
-rw-r--r--testsuite/tests/deriving/should_fail/Roles11.hs7
-rw-r--r--testsuite/tests/deriving/should_fail/Roles11.stderr5
-rw-r--r--testsuite/tests/deriving/should_fail/Roles12.hs5
-rw-r--r--testsuite/tests/deriving/should_fail/Roles12.hs-boot3
-rw-r--r--testsuite/tests/deriving/should_fail/Roles12.stderr12
-rw-r--r--testsuite/tests/deriving/should_fail/Roles5.hs5
-rw-r--r--testsuite/tests/deriving/should_fail/Roles5.stderr15
-rw-r--r--testsuite/tests/deriving/should_fail/Roles6.hs5
-rw-r--r--testsuite/tests/deriving/should_fail/Roles6.stderr5
-rw-r--r--testsuite/tests/deriving/should_fail/Roles7.hs6
-rw-r--r--testsuite/tests/deriving/should_fail/Roles7.stderr4
-rw-r--r--testsuite/tests/deriving/should_fail/Roles8.hs5
-rw-r--r--testsuite/tests/deriving/should_fail/Roles8.stderr5
-rw-r--r--testsuite/tests/deriving/should_fail/Roles9.hs12
-rw-r--r--testsuite/tests/deriving/should_fail/Roles9.stderr7
-rw-r--r--testsuite/tests/deriving/should_fail/T1496.hs16
-rw-r--r--testsuite/tests/deriving/should_fail/T1496.stderr7
-rw-r--r--testsuite/tests/deriving/should_fail/T2721.stderr2
-rwxr-xr-xtestsuite/tests/deriving/should_fail/T4846.hs37
-rw-r--r--testsuite/tests/deriving/should_fail/T4846.stderr7
-rw-r--r--testsuite/tests/deriving/should_fail/T7148.hs39
-rw-r--r--testsuite/tests/deriving/should_fail/T7148.stderr7
-rw-r--r--testsuite/tests/deriving/should_fail/T7148a.hs37
-rw-r--r--testsuite/tests/deriving/should_fail/T7148a.stderr7
-rw-r--r--testsuite/tests/deriving/should_fail/all.T15
-rw-r--r--testsuite/tests/gadt/CasePrune.stderr7
-rw-r--r--testsuite/tests/gadt/CasePrune.stdout1
-rw-r--r--testsuite/tests/gadt/all.T2
-rw-r--r--testsuite/tests/gadt/gadt11.hs11
-rw-r--r--testsuite/tests/gadt/gadt11.stderr10
-rw-r--r--testsuite/tests/indexed-types/should_compile/T3017.stderr6
-rw-r--r--testsuite/tests/perf/compiler/all.T10
-rw-r--r--testsuite/tests/polykinds/T7272.hs-boot4
-rw-r--r--testsuite/tests/rename/should_compile/Imp100Aux.hs-boot21
-rw-r--r--testsuite/tests/rename/should_compile/Imp10Aux.hs-boot22
-rw-r--r--testsuite/tests/rename/should_compile/Imp500Aux.hs-boot21
-rw-r--r--testsuite/tests/rename/should_fail/rnfail055.stderr32
-rw-r--r--testsuite/tests/safeHaskell/safeLanguage/SafeLang06.hs40
-rw-r--r--testsuite/tests/safeHaskell/safeLanguage/SafeLang06.stdout2
-rw-r--r--testsuite/tests/safeHaskell/safeLanguage/SafeLang06_A.hs24
-rw-r--r--testsuite/tests/safeHaskell/safeLanguage/all.T9
-rw-r--r--testsuite/tests/simplCore/should_compile/T4201.stdout2
-rw-r--r--testsuite/tests/th/T1835.stdout2
-rw-r--r--testsuite/tests/th/T4188.stderr12
-rw-r--r--testsuite/tests/th/TH_Roles1.hs8
-rw-r--r--testsuite/tests/th/TH_Roles1.stderr5
-rw-r--r--testsuite/tests/th/TH_Roles2.hs8
-rw-r--r--testsuite/tests/th/TH_Roles2.stderr16
-rw-r--r--testsuite/tests/th/TH_Roles3.hs9
-rw-r--r--testsuite/tests/th/TH_Roles3.stderr3
-rw-r--r--testsuite/tests/th/TH_reifyDecl1.stderr12
-rw-r--r--testsuite/tests/th/TH_reifyDecl2.stderr4
-rw-r--r--testsuite/tests/th/all.T4
-rw-r--r--testsuite/tests/typecheck/should_compile/tc231.stderr58
-rw-r--r--testsuite/tests/typecheck/should_fail/T3468.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/T7892.stderr2
71 files changed, 717 insertions, 187 deletions
diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr
index f8c5a0ac9c..6786117295 100644
--- a/testsuite/tests/deSugar/should_compile/T2431.stderr
+++ b/testsuite/tests/deSugar/should_compile/T2431.stderr
@@ -9,8 +9,8 @@ T2431.$WRefl [InlPrag=INLINE] :: forall a. a T2431.:~: a
Unf=Unf{Src=InlineStable, TopLvl=True, Arity=0, Value=True,
ConLike=True, WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=False)
- Tmpl= \ (@ a) -> T2431.Refl @ a @ a @~ <a>}]
-T2431.$WRefl = \ (@ a) -> T2431.Refl @ a @ a @~ <a>
+ Tmpl= \ (@ a) -> T2431.Refl @ a @ a @~ <a>_N}]
+T2431.$WRefl = \ (@ a) -> T2431.Refl @ a @ a @~ <a>_N
T2431.absurd
:: forall a. (GHC.Types.Int T2431.:~: GHC.Types.Bool) -> a
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
diff --git a/testsuite/tests/deriving/should_fail/Makefile b/testsuite/tests/deriving/should_fail/Makefile
index 629e011255..7e68e3840e 100644
--- a/testsuite/tests/deriving/should_fail/Makefile
+++ b/testsuite/tests/deriving/should_fail/Makefile
@@ -6,8 +6,11 @@ drvfail016:
$(RM) -f drvfail016.hi-boot drvfail016.o-boot
'$(TEST_HC)' $(TEST_HC_OPTS) -XGeneralizedNewtypeDeriving -c drvfail016.hs-boot; echo $$?
-.PHONY: T1133A
+.PHONY: T1133A Roles12
T1133A:
'$(TEST_HC)' $(TEST_HC_OPTS) -c T1133A.hs-boot
-'$(TEST_HC)' $(TEST_HC_OPTS) -c T1133A.hs
+Roles12:
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c Roles12.hs-boot
+ -'$(TEST_HC)' $(TEST_HC_OPTS) -c Roles12.hs
diff --git a/testsuite/tests/deriving/should_fail/Roles10.hs b/testsuite/tests/deriving/should_fail/Roles10.hs
new file mode 100644
index 0000000000..af19bfdf31
--- /dev/null
+++ b/testsuite/tests/deriving/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/deriving/should_fail/Roles10.stderr b/testsuite/tests/deriving/should_fail/Roles10.stderr
new file mode 100644
index 0000000000..caf83fc478
--- /dev/null
+++ b/testsuite/tests/deriving/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 N
+ In the newtype declaration for ‛Age’
diff --git a/testsuite/tests/deriving/should_fail/Roles11.hs b/testsuite/tests/deriving/should_fail/Roles11.hs
new file mode 100644
index 0000000000..c95cee798d
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles11.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE GADTs, RoleAnnotations #-}
+
+module Roles11 where
+
+data T2 a@R where
+ K2 :: T2 Int
+
diff --git a/testsuite/tests/deriving/should_fail/Roles11.stderr b/testsuite/tests/deriving/should_fail/Roles11.stderr
new file mode 100644
index 0000000000..5a3ad69e53
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles11.stderr
@@ -0,0 +1,5 @@
+
+Roles11.hs:5:1:
+ Role mismatch on variable a:
+ Annotation says R but role N is required
+ In the data declaration for ‛T2’
diff --git a/testsuite/tests/deriving/should_fail/Roles12.hs b/testsuite/tests/deriving/should_fail/Roles12.hs
new file mode 100644
index 0000000000..875d105b78
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles12.hs
@@ -0,0 +1,5 @@
+module Roles12 where
+
+import {-# SOURCE #-} Roles12
+
+data T a
diff --git a/testsuite/tests/deriving/should_fail/Roles12.hs-boot b/testsuite/tests/deriving/should_fail/Roles12.hs-boot
new file mode 100644
index 0000000000..6a708d984a
--- /dev/null
+++ b/testsuite/tests/deriving/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/deriving/should_fail/Roles12.stderr b/testsuite/tests/deriving/should_fail/Roles12.stderr
new file mode 100644
index 0000000000..e7f9329f6a
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles12.stderr
@@ -0,0 +1,12 @@
+
+Roles12.hs:5:6:
+ Type constructor ‛T’ has conflicting definitions in the module and its hs-boot file
+ Main module: data T a@P
+ No C type associated
+ RecFlag Recursive, Promotable
+ =
+ FamilyInstance: none
+ Boot file: abstract(False) T a@R
+ No C type associated
+ RecFlag NonRecursive, Not promotable
+ FamilyInstance: none
diff --git a/testsuite/tests/deriving/should_fail/Roles5.hs b/testsuite/tests/deriving/should_fail/Roles5.hs
new file mode 100644
index 0000000000..8fe983ccb9
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles5.hs
@@ -0,0 +1,5 @@
+module Roles5 where
+
+data T a@N
+class C a@R
+type S a@P = Int \ No newline at end of file
diff --git a/testsuite/tests/deriving/should_fail/Roles5.stderr b/testsuite/tests/deriving/should_fail/Roles5.stderr
new file mode 100644
index 0000000000..2a58a8a0ed
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles5.stderr
@@ -0,0 +1,15 @@
+
+Roles5.hs:3:8:
+ Illegal role annotation
+ Perhaps you intended to use -XRoleAnnotations
+ In the data type declaration for ‛T’
+
+Roles5.hs:4:9:
+ Illegal role annotation
+ Perhaps you intended to use -XRoleAnnotations
+ In the declaration for class C
+
+Roles5.hs:5:8:
+ Illegal role annotation
+ Perhaps you intended to use -XRoleAnnotations
+ In the declaration for type synonym ‛S’
diff --git a/testsuite/tests/deriving/should_fail/Roles6.hs b/testsuite/tests/deriving/should_fail/Roles6.hs
new file mode 100644
index 0000000000..56f80a1e2b
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles6.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE RoleAnnotations, TypeFamilies #-}
+
+module Roles6 where
+
+type family F a@R
diff --git a/testsuite/tests/deriving/should_fail/Roles6.stderr b/testsuite/tests/deriving/should_fail/Roles6.stderr
new file mode 100644
index 0000000000..4b89a9e40a
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles6.stderr
@@ -0,0 +1,5 @@
+
+Roles6.hs:5:1:
+ Illegal role annotation on variable a;
+ role annotations are not allowed here
+ In the family declaration for ‛F’
diff --git a/testsuite/tests/deriving/should_fail/Roles7.hs b/testsuite/tests/deriving/should_fail/Roles7.hs
new file mode 100644
index 0000000000..5d62803e3a
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles7.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE RoleAnnotations #-}
+
+module Roles7 where
+
+bar :: Int@P -> Int
+bar = id \ No newline at end of file
diff --git a/testsuite/tests/deriving/should_fail/Roles7.stderr b/testsuite/tests/deriving/should_fail/Roles7.stderr
new file mode 100644
index 0000000000..5e527a69f7
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles7.stderr
@@ -0,0 +1,4 @@
+
+Roles7.hs:5:8:
+ Illegal role annotation on Int
+ In the type signature for ‛bar’
diff --git a/testsuite/tests/deriving/should_fail/Roles8.hs b/testsuite/tests/deriving/should_fail/Roles8.hs
new file mode 100644
index 0000000000..b05cf5dad4
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles8.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE RoleAnnotations, GADTs #-}
+
+module Roles8 where
+
+data T1 a@P = K1 a
diff --git a/testsuite/tests/deriving/should_fail/Roles8.stderr b/testsuite/tests/deriving/should_fail/Roles8.stderr
new file mode 100644
index 0000000000..a650a66a30
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles8.stderr
@@ -0,0 +1,5 @@
+
+Roles8.hs:5:1:
+ Role mismatch on variable a:
+ Annotation says P but role R is required
+ In the data declaration for ‛T1’
diff --git a/testsuite/tests/deriving/should_fail/Roles9.hs b/testsuite/tests/deriving/should_fail/Roles9.hs
new file mode 100644
index 0000000000..86d10a3063
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles9.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, RoleAnnotations #-}
+
+module Roles9 where
+
+class C a@N where
+ meth :: a -> a
+
+instance C Int where
+ meth = (+ 1)
+
+newtype Age = MkAge Int
+ deriving C
diff --git a/testsuite/tests/deriving/should_fail/Roles9.stderr b/testsuite/tests/deriving/should_fail/Roles9.stderr
new file mode 100644
index 0000000000..611c377935
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/Roles9.stderr
@@ -0,0 +1,7 @@
+
+Roles9.hs:12: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 N
+ In the newtype declaration for ‛Age’
diff --git a/testsuite/tests/deriving/should_fail/T1496.hs b/testsuite/tests/deriving/should_fail/T1496.hs
new file mode 100644
index 0000000000..35675ebd97
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T1496.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}
+
+module T1496 where
+
+data family Z :: * -> *
+
+newtype instance Z Int = ZI Double
+newtype instance Z Moo = ZM (Int,Int)
+
+newtype Moo = Moo Int deriving(IsInt)
+class IsInt t where
+ isInt :: c Int -> c t
+
+instance IsInt Int where isInt = id
+
+main = case isInt (ZI 4.0) of ZM tu -> print tu \ No newline at end of file
diff --git a/testsuite/tests/deriving/should_fail/T1496.stderr b/testsuite/tests/deriving/should_fail/T1496.stderr
new file mode 100644
index 0000000000..32a67a6e46
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T1496.stderr
@@ -0,0 +1,7 @@
+
+T1496.hs:10:32:
+ Can't make a derived instance of ‛IsInt Moo’
+ (even with cunning newtype deriving):
+ it is not type-safe to use GeneralizedNewtypeDeriving on this class;
+ the last parameter of ‛IsInt’ is at role N
+ In the newtype declaration for ‛Moo’
diff --git a/testsuite/tests/deriving/should_fail/T2721.stderr b/testsuite/tests/deriving/should_fail/T2721.stderr
index 64e93c3d12..375c8a4247 100644
--- a/testsuite/tests/deriving/should_fail/T2721.stderr
+++ b/testsuite/tests/deriving/should_fail/T2721.stderr
@@ -3,4 +3,6 @@ T2721.hs:15:28:
Can't make a derived instance of ‛C N’
(even with cunning newtype deriving):
the class has associated types
+ it is not type-safe to use GeneralizedNewtypeDeriving on this class;
+ the last parameter of ‛C’ is at role N
In the newtype declaration for ‛N’
diff --git a/testsuite/tests/deriving/should_fail/T4846.hs b/testsuite/tests/deriving/should_fail/T4846.hs
new file mode 100755
index 0000000000..66621c04ee
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T4846.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE RankNTypes, ScopedTypeVariables, StandaloneDeriving, GADTs, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
+
+module Main where
+
+import Data.Typeable
+
+data Expr a where
+ Lit :: Typeable a => a -> Expr a
+
+class A a where
+ mk :: a
+
+class (Typeable a, A a) => B a where
+ mkExpr :: Expr a
+ mkExpr = Lit mk
+
+-- dfunAE
+instance B a => A (Expr a) where
+ mk = mkExpr
+
+-- dfunAB
+instance A Bool where
+ mk = True
+
+newtype BOOL = BOOL Bool
+ deriving (Typeable, A)
+
+instance B Bool
+deriving instance B BOOL --dfunBB
+
+showType :: forall a . Expr a -> String
+showType (Lit _) = show (typeOf (undefined :: a))
+
+test1 = showType (mk :: Expr BOOL) -- Prints "Bool" (wrong?)
+test2 = showType (Lit mk :: Expr BOOL) -- Prints "Main.BOOL" (correct)
+
+main = do { print test1; print test2 }
diff --git a/testsuite/tests/deriving/should_fail/T4846.stderr b/testsuite/tests/deriving/should_fail/T4846.stderr
new file mode 100644
index 0000000000..22556b0b6c
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T4846.stderr
@@ -0,0 +1,7 @@
+
+T4846.hs:29:1:
+ Can't make a derived instance of ‛B BOOL’
+ (even with cunning newtype deriving):
+ it is not type-safe to use GeneralizedNewtypeDeriving on this class;
+ the last parameter of ‛B’ is at role N
+ In the stand-alone deriving instance for ‛B BOOL’
diff --git a/testsuite/tests/deriving/should_fail/T7148.hs b/testsuite/tests/deriving/should_fail/T7148.hs
new file mode 100644
index 0000000000..1f91286e05
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T7148.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, GADTs #-}
+
+module T7148 where
+
+data SameType a b where
+ Refl :: SameType a a
+
+coerce :: SameType a b -> a -> b
+coerce Refl = id
+
+trans :: SameType a b -> SameType b c -> SameType a c
+trans Refl Refl = Refl
+
+sameUnit :: SameType () ()
+sameUnit = Refl
+
+
+class IsoUnit a where
+ iso1 :: SameType () b -> SameType a b
+ iso2 :: SameType b () -> SameType b a
+
+instance IsoUnit () where
+ iso1 = id
+ iso2 = id
+
+
+newtype Tagged a b = Tagged b deriving IsoUnit
+
+sameTagged :: SameType (Tagged a b) (Tagged a' b') -> SameType a a'
+sameTagged Refl = Refl
+
+unsafe' :: SameType (Tagged a ()) (Tagged a' ())
+unsafe' = (iso1 sameUnit) `trans` (iso2 sameUnit)
+
+unsafe :: SameType a b
+unsafe = sameTagged unsafe'
+
+--once again inferred type is a -> b
+unsafeCoerce = coerce unsafe \ No newline at end of file
diff --git a/testsuite/tests/deriving/should_fail/T7148.stderr b/testsuite/tests/deriving/should_fail/T7148.stderr
new file mode 100644
index 0000000000..dcee25ff5f
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T7148.stderr
@@ -0,0 +1,7 @@
+
+T7148.hs:27:40:
+ Can't make a derived instance of ‛IsoUnit (Tagged a b)’
+ (even with cunning newtype deriving):
+ it is not type-safe to use GeneralizedNewtypeDeriving on this class;
+ the last parameter of ‛IsoUnit’ is at role N
+ In the newtype declaration for ‛Tagged’
diff --git a/testsuite/tests/deriving/should_fail/T7148a.hs b/testsuite/tests/deriving/should_fail/T7148a.hs
new file mode 100644
index 0000000000..6441058b24
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T7148a.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE TypeFamilies, ScopedTypeVariables,
+ GeneralizedNewtypeDeriving #-}
+
+module T7148a where
+
+import Control.Monad.ST
+data Proxy a = Proxy
+type family Result a b
+
+class Convert a where
+ coerce :: Proxy b -> a -> Result a b
+
+newtype SAFE a = SAFE a
+type instance Result (SAFE a) b = a
+
+instance Convert (SAFE a) where
+ coerce _ (SAFE a) = a
+
+newtype IS_NO_LONGER a = IS_NO_LONGER a deriving Convert
+type instance Result (IS_NO_LONGER a) b = b
+
+--infered type is
+unsafeCoerce :: forall a b. a -> b
+unsafeCoerce = coerce (Proxy :: Proxy b) . IS_NO_LONGER . SAFE
+
+--use it safely
+id' :: a -> a
+id' = unsafeCoerce
+
+--segfault (with high probability)
+crash :: segfault
+crash = unsafeCoerce . tail . tail . tail . unsafeCoerce $ True
+
+
+--time for side effects
+unsafePerformIO :: IO a -> a
+unsafePerformIO x = runST $ unsafeCoerce x \ No newline at end of file
diff --git a/testsuite/tests/deriving/should_fail/T7148a.stderr b/testsuite/tests/deriving/should_fail/T7148a.stderr
new file mode 100644
index 0000000000..f2a938c0a7
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T7148a.stderr
@@ -0,0 +1,7 @@
+
+T7148a.hs:19:50:
+ Can't make a derived instance of ‛Convert (IS_NO_LONGER a)’
+ (even with cunning newtype deriving):
+ it is not type-safe to use GeneralizedNewtypeDeriving on this class;
+ the last parameter of ‛Convert’ is at role N
+ In the newtype declaration for ‛IS_NO_LONGER’
diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T
index c2d304ee19..610f1181fe 100644
--- a/testsuite/tests/deriving/should_fail/all.T
+++ b/testsuite/tests/deriving/should_fail/all.T
@@ -41,3 +41,18 @@ test('T1133A',
['$MAKE --no-print-directory -s T1133A'])
test('T5863a', normal, compile_fail, [''])
test('T7959', normal, compile_fail, [''])
+
+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'])
+test('T1496', normal, compile_fail, [''])
+test('T4846', normal, compile_fail, [''])
+test('T7148', normal, compile_fail, [''])
+test('T7148a', normal, compile_fail, [''])
diff --git a/testsuite/tests/gadt/CasePrune.stderr b/testsuite/tests/gadt/CasePrune.stderr
new file mode 100644
index 0000000000..8057e16653
--- /dev/null
+++ b/testsuite/tests/gadt/CasePrune.stderr
@@ -0,0 +1,7 @@
+
+CasePrune.hs:14:31:
+ Can't make a derived instance of ‛C A’
+ (even with cunning newtype deriving):
+ it is not type-safe to use GeneralizedNewtypeDeriving on this class;
+ the last parameter of ‛C’ is at role N
+ In the newtype declaration for ‛A’
diff --git a/testsuite/tests/gadt/CasePrune.stdout b/testsuite/tests/gadt/CasePrune.stdout
deleted file mode 100644
index 52c33a57c7..0000000000
--- a/testsuite/tests/gadt/CasePrune.stdout
+++ /dev/null
@@ -1 +0,0 @@
-"ok"
diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T
index 1be8260363..d23d1fc1b4 100644
--- a/testsuite/tests/gadt/all.T
+++ b/testsuite/tests/gadt/all.T
@@ -88,7 +88,7 @@ test('gadt-escape1', normal, compile_fail, [''])
# test('Arith', normal, compile, [''])
test('Session', normal, compile_and_run, [''])
-test('CasePrune', normal, compile_and_run, [''])
+test('CasePrune', normal, compile_fail, [''])
test('T1999', normal, compile, [''])
test('T1999a', normal, compile, [''])
diff --git a/testsuite/tests/gadt/gadt11.hs b/testsuite/tests/gadt/gadt11.hs
index a5000442fa..c0e176f1ff 100644
--- a/testsuite/tests/gadt/gadt11.hs
+++ b/testsuite/tests/gadt/gadt11.hs
@@ -3,10 +3,11 @@
module ShouldFail where
-- Wrong return type
-data X f = X (f ())
-
-data B a where
- B1 :: X []
- B2 :: B [Int]
+data T1 a where
+ K1 :: T1 Int
+ K2 :: T2 Int -> T1 Bool
+data T2 a where
+ L1 :: T2 Int
+ L2 :: T1 Bool
diff --git a/testsuite/tests/gadt/gadt11.stderr b/testsuite/tests/gadt/gadt11.stderr
index 96f636c0a6..b753bd961c 100644
--- a/testsuite/tests/gadt/gadt11.stderr
+++ b/testsuite/tests/gadt/gadt11.stderr
@@ -1,6 +1,6 @@
-gadt11.hs:9:3:
- Data constructor ‛B1’ returns type ‛X []’
- instead of an instance of its parent type ‛B a’
- In the definition of data constructor ‛B1’
- In the data declaration for ‛B’
+gadt11.hs:12:3:
+ Data constructor ‛L2’ returns type ‛T1 Bool’
+ instead of an instance of its parent type ‛T2 a’
+ In the definition of data constructor ‛L2’
+ In the data declaration for ‛T2’
diff --git a/testsuite/tests/indexed-types/should_compile/T3017.stderr b/testsuite/tests/indexed-types/should_compile/T3017.stderr
index 5c6a2641c7..f8e8292313 100644
--- a/testsuite/tests/indexed-types/should_compile/T3017.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T3017.stderr
@@ -4,12 +4,12 @@ TYPE SIGNATURES
forall c t t1. (Num t, Num t1, Coll c, Elem c ~ (t, t1)) => c -> c
TYPE CONSTRUCTORS
Coll :: * -> Constraint
- class Coll c
+ class Coll c@N
RecFlag NonRecursive
- type family Elem c :: *
+ type family Elem c@N :: *
empty :: c insert :: Elem c -> c -> c
ListColl :: * -> *
- data ListColl a
+ data ListColl a@R
No C type associated
RecFlag NonRecursive, Promotable
= L :: forall a. [a] -> ListColl a Stricts: _
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 9b58d1bc77..8f23c0c29f 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -180,18 +180,20 @@ test('T3064',
[(wordsize(32), 111189536, 10),
# expected value: 56380288 (x86/Linux) (28/6/2011)
# 111189536 (x86/Windows) (30/10/12)
- (wordsize(64), 224798696, 5)]),
+ (wordsize(64), 236404384, 5)]),
# (amd64/Linux) (28/06/2011): 73259544
# (amd64/Linux) (07/02/2013): 224798696
+ # (amd64/Linux) (02/08/2013): 236404384, increase from roles
compiler_stats_num_field('max_bytes_used',
[(wordsize(32), 5511604, 20),
# expected value: 2247016 (x86/Linux) (28/6/2011):
- (wordsize(64), 9397488, 10)]),
+ (wordsize(64), 10742536, 10)]),
# (amd64/Linux, intree) (28/06/2011): 4032024
# (amd64/Linux, intree) (07/02/2013): 9819288
# (amd64/Linux) (14/02/2013): 8687360
# (amd64/Linux) (18/02/2013): 9397488
+ # (amd64/Linux) (02/08/2013): 10742536, increase from roles
only_ways(['normal'])
],
compile,
@@ -207,12 +209,14 @@ test('T5030',
[(wordsize(32), 259547660, 10),
# previous: 196457520
# 2012-10-08: 259547660 (x86/Linux, new codegen)
- (wordsize(64), 538467496, 10)]),
+ (wordsize(64), 454498592, 10)]),
# Previously 530000000 (+/- 10%)
# 17/1/13: 602993184 (x86_64/Linux)
# (new demand analyser)
# 2013-06-08 538467496 (x86_64/Linux)
# ^ reason unknown
+ # 2013-08-02 454498592 (amd64/Linux)
+ # decrease from more aggressive coercion optimisations from roles
only_ways(['normal'])
],
diff --git a/testsuite/tests/polykinds/T7272.hs-boot b/testsuite/tests/polykinds/T7272.hs-boot
index fa46e1e463..0fcc02f71b 100644
--- a/testsuite/tests/polykinds/T7272.hs-boot
+++ b/testsuite/tests/polykinds/T7272.hs-boot
@@ -1,5 +1,5 @@
-{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE PolyKinds, RoleAnnotations #-}
module T7272 where
-class C (a :: k)
+class C (a :: k)@P
diff --git a/testsuite/tests/rename/should_compile/Imp100Aux.hs-boot b/testsuite/tests/rename/should_compile/Imp100Aux.hs-boot
index 934db61841..b197c47805 100644
--- a/testsuite/tests/rename/should_compile/Imp100Aux.hs-boot
+++ b/testsuite/tests/rename/should_compile/Imp100Aux.hs-boot
@@ -1,11 +1,12 @@
+{-# LANGUAGE RoleAnnotations #-}
module Imp100Aux where
-data T1 a
-data T2 a b
-data T3 a b c
-data T4 a b c d
-data T5 a b c d e
-data T6 a
-data T7 a b
-data T8 a b c
-data T9 a b c d
-data T10 a b c d e
+data T1 a@P
+data T2 a@P b@P
+data T3 a@P b@P c@P
+data T4 a@P b@P c@P d@P
+data T5 a@P b@P c@P d@P e@P
+data T6 a@P
+data T7 a@P b@P
+data T8 a@P b@P c@P
+data T9 a@P b@P c@P d@P
+data T10 a@P b@P c@P d@P e@P
diff --git a/testsuite/tests/rename/should_compile/Imp10Aux.hs-boot b/testsuite/tests/rename/should_compile/Imp10Aux.hs-boot
index 248c113ba2..cfe980e2f0 100644
--- a/testsuite/tests/rename/should_compile/Imp10Aux.hs-boot
+++ b/testsuite/tests/rename/should_compile/Imp10Aux.hs-boot
@@ -1,11 +1,13 @@
+{-# LANGUAGE RoleAnnotations #-}
+
module Imp10Aux where
-data T1 a
-data T2 a b
-data T3 a b c
-data T4 a b c d
-data T5 a b c d e
-data T6 a
-data T7 a b
-data T8 a b c
-data T9 a b c d
-data T10 a b c d e
+data T1 a@P
+data T2 a@P b@P
+data T3 a@P b@P c@P
+data T4 a@P b@P c@P d@P
+data T5 a@P b@P c@P d@P e@P
+data T6 a@P
+data T7 a@P b@P
+data T8 a@P b@P c@P
+data T9 a@P b@P c@P d@P
+data T10 a@P b@P c@P d@P e@P
diff --git a/testsuite/tests/rename/should_compile/Imp500Aux.hs-boot b/testsuite/tests/rename/should_compile/Imp500Aux.hs-boot
index 251ac8012c..9dc4ea2a74 100644
--- a/testsuite/tests/rename/should_compile/Imp500Aux.hs-boot
+++ b/testsuite/tests/rename/should_compile/Imp500Aux.hs-boot
@@ -1,11 +1,12 @@
+{-# LANGUAGE RoleAnnotations #-}
module Imp500Aux where
-data T1 a
-data T2 a b
-data T3 a b c
-data T4 a b c d
-data T5 a b c d e
-data T6 a
-data T7 a b
-data T8 a b c
-data T9 a b c d
-data T10 a b c d e
+data T1 a@P
+data T2 a@P b@P
+data T3 a@P b@P c@P
+data T4 a@P b@P c@P d@P
+data T5 a@P b@P c@P d@P e@P
+data T6 a@P
+data T7 a@P b@P
+data T8 a@P b@P c@P
+data T9 a@P b@P c@P d@P
+data T10 a@P b@P c@P d@P e@P
diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr
index 992cfc5150..41a2bd095c 100644
--- a/testsuite/tests/rename/should_fail/rnfail055.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail055.stderr
@@ -12,22 +12,22 @@ RnFail055.hs-boot:4:1:
RnFail055.hs-boot:6:6:
Type constructor ‛S1’ has conflicting definitions in the module and its hs-boot file
- Main module: type S1 a b = (a, b)
- Boot file: type S1 a b c = (a, b)
+ Main module: type S1 a@R b@R = (a, b)
+ Boot file: type S1 a@R b@R c@R = (a, b)
RnFail055.hs-boot:8:6:
Type constructor ‛S2’ has conflicting definitions in the module and its hs-boot file
- Main module: type S2 a b = forall a1. (a1, b)
- Boot file: type S2 a b = forall b1. (a, b1)
+ Main module: type S2 a@P b@R = forall a1. (a1, b)
+ Boot file: type S2 a@R b@R = forall b1. (a, b1)
RnFail055.hs-boot:12:6:
Type constructor ‛T1’ has conflicting definitions in the module and its hs-boot file
- Main module: data T1 a b
+ Main module: data T1 a@R b@R
No C type associated
RecFlag Recursive, Promotable
= T1 :: forall a b. [b] -> [a] -> T1 a b Stricts: _ _
FamilyInstance: none
- Boot file: data T1 a b
+ Boot file: data T1 a@R b@R
No C type associated
RecFlag NonRecursive, Promotable
= T1 :: forall a b. [a] -> [b] -> T1 a b Stricts: _ _
@@ -35,12 +35,12 @@ RnFail055.hs-boot:12:6:
RnFail055.hs-boot:14:16:
Type constructor ‛T2’ has conflicting definitions in the module and its hs-boot file
- Main module: data Eq b => T2 a b
+ Main module: data Eq b => T2 a@R b@P
No C type associated
RecFlag Recursive, Promotable
= T2 :: forall a b. a -> T2 a b Stricts: _
FamilyInstance: none
- Boot file: data Eq a => T2 a b
+ Boot file: data Eq a => T2 a@R b@R
No C type associated
RecFlag NonRecursive, Promotable
= T2 :: forall a b. a -> T2 a b Stricts: _
@@ -54,12 +54,12 @@ RnFail055.hs-boot:17:12:
RnFail055.hs-boot:21:6:
Type constructor ‛T5’ has conflicting definitions in the module and its hs-boot file
- Main module: data T5 a
+ Main module: data T5 a@R
No C type associated
RecFlag Recursive, Promotable
= T5 :: forall a. a -> T5 a Stricts: _ Fields: field5
FamilyInstance: none
- Boot file: data T5 a
+ Boot file: data T5 a@R
No C type associated
RecFlag NonRecursive, Promotable
= T5 :: forall a. a -> T5 a Stricts: _
@@ -80,12 +80,12 @@ RnFail055.hs-boot:23:6:
RnFail055.hs-boot:25:6:
Type constructor ‛T7’ has conflicting definitions in the module and its hs-boot file
- Main module: data T7 a
+ Main module: data T7 a@P
No C type associated
RecFlag Recursive, Promotable
= T7 :: forall a a1. a1 -> T7 a Stricts: _
FamilyInstance: none
- Boot file: data T7 a
+ Boot file: data T7 a@R
No C type associated
RecFlag NonRecursive, Promotable
= T7 :: forall a. a -> T7 a Stricts: _
@@ -96,14 +96,14 @@ RnFail055.hs-boot:27:22:
RnFail055.hs-boot:28:7:
Class ‛C2’ has conflicting definitions in the module and its hs-boot file
- Main module: class C2 a b
+ Main module: class C2 a@R b@R
RecFlag Recursive
m2 :: a -> b m2' :: a -> b
- Boot file: class C2 a b
+ Boot file: class C2 a@R b@R
RecFlag NonRecursive
m2 :: a -> b
RnFail055.hs-boot:29:24:
Class ‛C3’ has conflicting definitions in the module and its hs-boot file
- Main module: class (Eq a, Ord a) => C3 a RecFlag Recursive
- Boot file: class (Ord a, Eq a) => C3 a RecFlag NonRecursive
+ Main module: class (Eq a, Ord a) => C3 a@R RecFlag Recursive
+ Boot file: class (Ord a, Eq a) => C3 a@R RecFlag NonRecursive
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang06.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang06.hs
deleted file mode 100644
index 685846f150..0000000000
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang06.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
--- Here we allow it to succeed (No SAFE)
-
--- | We use newtype to create an isomorphic type to Int
--- with a reversed Ord dictionary. We now use the MinList
--- API of Y1 to create a new MinList. Then we use newtype
--- deriving to convert the newtype MinList to an Int
--- MinList. This final result breaks the invariants of
--- MinList which shouldn't be possible with the exposed
--- API of Y1.
-module Main where
-
-import SafeLang06_A
-
-class IntIso t where
- intIso :: c t -> c Int
-
-instance IntIso Int where
- intIso = id
-
-newtype Down a = Down a deriving (Eq, Show, IntIso)
-
-instance Ord a => Ord (Down a) where
- compare (Down a) (Down b) = compare b a
-
-forceInt :: MinList Int -> MinList Int
-forceInt = id
-
-a1, a2 :: MinList Int
-a1 = foldl insertMinList (newMinList $ head nums) (tail nums)
-a2 = forceInt $ intIso $ foldl (\x y -> insertMinList x $ Down y) (newMinList $ Down $ head nums) (tail nums)
-
-nums :: [Int]
-nums = [1,4,0,1,-5,2,3,5,-1,2,0,0,-4,-3,9]
-
-main = do
- printIntMinList a1
- printIntMinList a2
-
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang06.stdout b/testsuite/tests/safeHaskell/safeLanguage/SafeLang06.stdout
deleted file mode 100644
index ed005737b7..0000000000
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang06.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-MinList Int :: MinList 1 [9,2,5,3,2,4]
-MinList Int :: MinList 1 [-3,-4,0,0,-1,-5,0]
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang06_A.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang06_A.hs
deleted file mode 100644
index d092ae7a1a..0000000000
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang06_A.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-
--- | Here we expose a MinList API that only allows elements
--- to be inserted into a list if they are at least greater
--- than an initial element the list is created with.
-module SafeLang06_A (
- MinList,
- newMinList,
- insertMinList,
- printIntMinList
- ) where
-
-data MinList a = MinList a [a]
-
-newMinList :: Ord a => a -> MinList a
-newMinList n = MinList n []
-
-insertMinList :: Ord a => MinList a -> a -> MinList a
-insertMinList s@(MinList m xs) n | n > m = MinList m (n:xs)
- | otherwise = s
-
-printIntMinList :: MinList Int -> IO ()
-printIntMinList (MinList min xs) = putStrLn $ "MinList Int :: MinList " ++ show min ++ " " ++ show xs
-
diff --git a/testsuite/tests/safeHaskell/safeLanguage/all.T b/testsuite/tests/safeHaskell/safeLanguage/all.T
index e2b5d1b656..5932348594 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/all.T
+++ b/testsuite/tests/safeHaskell/safeLanguage/all.T
@@ -14,10 +14,11 @@ test('SafeLang02', normal, compile, [''])
test('SafeLang03', normal, compile, [''])
test('SafeLang04', normal, compile_and_run, [''])
test('SafeLang05', normal, compile_and_run, [''])
-test('SafeLang06',
- extra_clean(['SafeLang06_A.o', 'SafeLang06_A.hi']),
- compile_and_run,
- [''])
+
+# SafeLang06 was a test involving GeneralizedNewtypeDeriving, but the code
+# fails to compile with roles; thus the test is no longer valid and has
+# been removed
+
test('SafeLang07', normal, compile_fail, [''])
test('SafeLang08', normal, compile_fail, [''])
test('SafeLang09',
diff --git a/testsuite/tests/simplCore/should_compile/T4201.stdout b/testsuite/tests/simplCore/should_compile/T4201.stdout
index e93fbd6f12..ed519ed02f 100644
--- a/testsuite/tests/simplCore/should_compile/T4201.stdout
+++ b/testsuite/tests/simplCore/should_compile/T4201.stdout
@@ -1,3 +1,3 @@
{- Arity: 1, HasNoCafRefs, Strictness: <S,1*U()>m,
Unfolding: InlineRule (0, True, True)
- Eta.bof `cast` (Sym (Eta.NTCo:Foo[0]) -> Refl Eta.T) -}
+ Eta.bof `cast` (Sym (Eta.NTCo:Foo[0]) ->_R <Eta.T>_R) -}
diff --git a/testsuite/tests/th/T1835.stdout b/testsuite/tests/th/T1835.stdout
index ba8e65f418..cbe455bca1 100644
--- a/testsuite/tests/th/T1835.stdout
+++ b/testsuite/tests/th/T1835.stdout
@@ -1,4 +1,4 @@
-class GHC.Classes.Eq a_0 => Main.MyClass a_0
+class GHC.Classes.Eq a_0 => Main.MyClass a_0@R
instance Main.MyClass Main.Foo
instance Main.MyClass Main.Baz
instance GHC.Classes.Eq a_1 => Main.MyClass (Main.Quux a_1)
diff --git a/testsuite/tests/th/T4188.stderr b/testsuite/tests/th/T4188.stderr
index 469a2d3840..187d902ac1 100644
--- a/testsuite/tests/th/T4188.stderr
+++ b/testsuite/tests/th/T4188.stderr
@@ -1,6 +1,6 @@
-data T4188.T1 a_0 = forall b_1 . T4188.MkT1 a_0 b_1
-data T4188.T2 a_0
- = forall b_1 . (T4188.C a_0, T4188.C b_1) => T4188.MkT2 a_0 b_1
-data T4188.T3 x_0
- = forall x_1 y_2 . (x_0 ~ (x_1, y_2), T4188.C x_1, T4188.C y_2) =>
- T4188.MkT3 x_1 y_2
+data T4188.T1 a_0@R = forall b_1 . T4188.MkT1 a_0 b_1
+data T4188.T2 a_0@R
+ = forall b_1 . (T4188.C a_0, T4188.C b_1) => T4188.MkT2 a_0 b_1
+data T4188.T3 x_0@N
+ = forall x_1 y_2 . (x_0 ~ (x_1, y_2), T4188.C x_1, T4188.C y_2) =>
+ T4188.MkT3 x_1 y_2
diff --git a/testsuite/tests/th/TH_Roles1.hs b/testsuite/tests/th/TH_Roles1.hs
new file mode 100644
index 0000000000..5829895f59
--- /dev/null
+++ b/testsuite/tests/th/TH_Roles1.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module TH_Roles1 where
+
+import Language.Haskell.TH
+
+$( return [DataD [] (mkName "T") [RoledTV (mkName "a") Representational] [] []] )
+
diff --git a/testsuite/tests/th/TH_Roles1.stderr b/testsuite/tests/th/TH_Roles1.stderr
new file mode 100644
index 0000000000..0b1ac3338c
--- /dev/null
+++ b/testsuite/tests/th/TH_Roles1.stderr
@@ -0,0 +1,5 @@
+
+TH_Roles1.hs:7:4:
+ Illegal role annotation
+ Perhaps you intended to use -XRoleAnnotations
+ In the data type declaration for ‛T’
diff --git a/testsuite/tests/th/TH_Roles2.hs b/testsuite/tests/th/TH_Roles2.hs
new file mode 100644
index 0000000000..fc010df9ed
--- /dev/null
+++ b/testsuite/tests/th/TH_Roles2.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell, RoleAnnotations, PolyKinds #-}
+
+module TH_Roles2 where
+
+import Language.Haskell.TH
+
+$( return [DataD [] (mkName "T") [KindedRoledTV (mkName "a") (VarT (mkName "k")) Representational] [] []] )
+
diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr
new file mode 100644
index 0000000000..4d85768387
--- /dev/null
+++ b/testsuite/tests/th/TH_Roles2.stderr
@@ -0,0 +1,16 @@
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+ T :: forall (k :: BOX). k -> *
+ data T (k::BOX)@N (a::k)@R
+ No C type associated
+ RecFlag NonRecursive, Not promotable
+ =
+ FamilyInstance: none
+COERCION AXIOMS
+Dependent modules: []
+Dependent packages: [array-0.4.0.2, base, containers-0.5.0.0,
+ deepseq-1.3.0.2, ghc-prim, integer-gmp, pretty-1.1.1.0,
+ template-haskell]
+
+==================== Typechecker ====================
+
diff --git a/testsuite/tests/th/TH_Roles3.hs b/testsuite/tests/th/TH_Roles3.hs
new file mode 100644
index 0000000000..355b1e595a
--- /dev/null
+++ b/testsuite/tests/th/TH_Roles3.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell, PolyKinds, RoleAnnotations #-}
+
+module Roles3 where
+
+import Language.Haskell.TH
+
+$( do { decls <- [d| data Foo a (b :: k) c@R (d :: k)@N |]
+ ; reportWarning (pprint decls)
+ ; return decls })
diff --git a/testsuite/tests/th/TH_Roles3.stderr b/testsuite/tests/th/TH_Roles3.stderr
new file mode 100644
index 0000000000..b1bfd20825
--- /dev/null
+++ b/testsuite/tests/th/TH_Roles3.stderr
@@ -0,0 +1,3 @@
+
+TH_Roles3.hs:7:4: Warning:
+ data Foo_0 a_1 (b_2 :: k_3) c_4@R (d_5 :: k_3)@N
diff --git a/testsuite/tests/th/TH_reifyDecl1.stderr b/testsuite/tests/th/TH_reifyDecl1.stderr
index 82a4f572ce..0f44e4b862 100644
--- a/testsuite/tests/th/TH_reifyDecl1.stderr
+++ b/testsuite/tests/th/TH_reifyDecl1.stderr
@@ -1,9 +1,9 @@
data TH_reifyDecl1.T = TH_reifyDecl1.A | TH_reifyDecl1.B
-data TH_reifyDecl1.R a_0 = TH_reifyDecl1.C a_0 | TH_reifyDecl1.D
-data TH_reifyDecl1.List a_0
+data TH_reifyDecl1.R a_0@R = TH_reifyDecl1.C a_0 | TH_reifyDecl1.D
+data TH_reifyDecl1.List a_0@R
= TH_reifyDecl1.Nil
| TH_reifyDecl1.Cons a_0 (TH_reifyDecl1.List a_0)
-data TH_reifyDecl1.Tree a_0
+data TH_reifyDecl1.Tree a_0@P
= TH_reifyDecl1.Leaf
| (TH_reifyDecl1.Tree a_0) TH_reifyDecl1.:+: (TH_reifyDecl1.Tree a_0)
type TH_reifyDecl1.IntList = [GHC.Types.Int]
@@ -12,14 +12,14 @@ Constructor from TH_reifyDecl1.Tree: TH_reifyDecl1.Leaf :: forall a_0 . TH_reify
Class op from TH_reifyDecl1.C1: TH_reifyDecl1.m1 :: forall a_0 . TH_reifyDecl1.C1 a_0 =>
a_0 -> GHC.Types.Int
infixl 3 TH_reifyDecl1.m1
-class TH_reifyDecl1.C1 a_0
+class TH_reifyDecl1.C1 a_0@R
where TH_reifyDecl1.m1 :: forall a_0 . TH_reifyDecl1.C1 a_0 =>
a_0 -> GHC.Types.Int
-class TH_reifyDecl1.C2 a_0
+class TH_reifyDecl1.C2 a_0@R
where TH_reifyDecl1.m2 :: forall a_0 . TH_reifyDecl1.C2 a_0 =>
a_0 -> GHC.Types.Int
instance TH_reifyDecl1.C2 GHC.Types.Int
-class TH_reifyDecl1.C3 a_0
+class TH_reifyDecl1.C3 a_0@N
instance TH_reifyDecl1.C3 GHC.Types.Int
type family TH_reifyDecl1.AT1 a_0 :: * -> *
type instance TH_reifyDecl1.AT1 GHC.Types.Int = GHC.Types.Bool
diff --git a/testsuite/tests/th/TH_reifyDecl2.stderr b/testsuite/tests/th/TH_reifyDecl2.stderr
index 1beab4d9c3..65bbd75dd5 100644
--- a/testsuite/tests/th/TH_reifyDecl2.stderr
+++ b/testsuite/tests/th/TH_reifyDecl2.stderr
@@ -1,2 +1,2 @@
-data Data.Maybe.Maybe a_0 = Data.Maybe.Nothing
- | Data.Maybe.Just a_0
+data Data.Maybe.Maybe a_0@R
+ = Data.Maybe.Nothing | Data.Maybe.Just a_0
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 73d60af786..2840387675 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -281,3 +281,7 @@ test('T8028',
extra_clean(['T8028a.hi', 'T8028a.o']),
multimod_compile_fail,
['T8028', '-v0 ' + config.ghc_th_way_flags])
+
+test('TH_Roles1', normal, compile_fail, ['-v0'])
+test('TH_Roles2', normal, compile, ['-v0 -ddump-tc'])
+test('TH_Roles3', normal, compile, ['-v0 -dsuppress-uniques']) \ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_compile/tc231.stderr b/testsuite/tests/typecheck/should_compile/tc231.stderr
index e8ebcc7ba8..92155f0588 100644
--- a/testsuite/tests/typecheck/should_compile/tc231.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc231.stderr
@@ -1,29 +1,29 @@
-TYPE SIGNATURES
- foo ::
- forall s b chain.
- Zork s (Z [Char]) b =>
- Q s (Z [Char]) chain -> ST s ()
- s :: forall t t1. Q t (Z [Char]) t1 -> Q t (Z [Char]) t1
-TYPE CONSTRUCTORS
- Q :: * -> * -> * -> *
- data Q s a chain
- No C type associated
- RecFlag NonRecursive, Promotable
- = Node :: forall s a chain. s -> a -> chain -> Q s a chain
- Stricts: _ _ _
- FamilyInstance: none
- Z :: * -> *
- data Z a
- No C type associated
- RecFlag NonRecursive, Promotable
- = Z :: forall a. a -> Z a Stricts: _
- FamilyInstance: none
- Zork :: * -> * -> * -> Constraint
- class Zork s a b | a -> b
- RecFlag NonRecursive
- huh :: forall chain. Q s a chain -> ST s ()
-COERCION AXIOMS
- axiom ShouldCompile.NTCo:Zork ::
- Zork s a b = forall chain. Q s a chain -> ST s ()
-Dependent modules: []
-Dependent packages: [base, ghc-prim, integer-gmp]
+TYPE SIGNATURES
+ foo ::
+ forall s b chain.
+ Zork s (Z [Char]) b =>
+ Q s (Z [Char]) chain -> ST s ()
+ s :: forall t t1. Q t (Z [Char]) t1 -> Q t (Z [Char]) t1
+TYPE CONSTRUCTORS
+ Q :: * -> * -> * -> *
+ data Q s@R a@R chain@R
+ No C type associated
+ RecFlag NonRecursive, Promotable
+ = Node :: forall s a chain. s -> a -> chain -> Q s a chain
+ Stricts: _ _ _
+ FamilyInstance: none
+ Z :: * -> *
+ data Z a@R
+ No C type associated
+ RecFlag NonRecursive, Promotable
+ = Z :: forall a. a -> Z a Stricts: _
+ FamilyInstance: none
+ Zork :: * -> * -> * -> Constraint
+ class Zork s@N a@R b@P | a -> b
+ RecFlag NonRecursive
+ huh :: forall chain. Q s a chain -> ST s ()
+COERCION AXIOMS
+ axiom ShouldCompile.NTCo:Zork ::
+ Zork s a b = forall chain. Q s a chain -> ST s ()
+Dependent modules: []
+Dependent packages: [base, ghc-prim, integer-gmp]
diff --git a/testsuite/tests/typecheck/should_fail/T3468.stderr b/testsuite/tests/typecheck/should_fail/T3468.stderr
index 16450c14d4..e12db7a747 100644
--- a/testsuite/tests/typecheck/should_fail/T3468.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3468.stderr
@@ -1,7 +1,7 @@
T3468.hs-boot:3:6:
Type constructor ‛Tool’ has conflicting definitions in the module and its hs-boot file
- Main module: data Tool d
+ Main module: data Tool d@P
No C type associated
RecFlag Recursive, Promotable
= F :: forall d a. a -> Tool d Stricts: _
diff --git a/testsuite/tests/typecheck/should_fail/T7892.stderr b/testsuite/tests/typecheck/should_fail/T7892.stderr
index eec7bd73dc..882aca64d6 100644
--- a/testsuite/tests/typecheck/should_fail/T7892.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7892.stderr
@@ -1,2 +1,2 @@
-T7892.hs:5:4: Couldn't match kind ‛*’ against ‛* -> *’
+T7892.hs:5:4: Couldn't match kind ‛* -> *’ against ‛*’