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.

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