summaryrefslogtreecommitdiff
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
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.
-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 ‛*’