11 files changed, 68 insertions, 15 deletions
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