Update to tests due to change in syntax for role annotations.

32 files changed, 430 insertions, 0 deletions

diff --git a/testsuite/tests/roles/Makefile b/testsuite/tests/roles/Makefile
new file mode 100644
index 0000000000..9a36a1c5fe
--- /dev/null
+++ b/testsuite/tests/roles/Makefile
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/roles/should_compile/Makefile b/testsuite/tests/roles/should_compile/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/roles/should_compile/Roles1.hs b/testsuite/tests/roles/should_compile/Roles1.hs
new file mode 100644
index 0000000000..ca040c4353
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Roles1.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE RoleAnnotations, PolyKinds #-}
+
+module Roles1 where
+
+data T1 a = K1 a
+data T2 a = K2 a
+data T3 (a :: k) = K3
+data T4 (a :: * -> *) b = K4 (a b)
+
+data T5 a = K5 a
+data T6 a = K6
+data T7 a b = K7 b
+
+type role T1 nominal
+type role T2 representational
+type role T3 phantom
+type role T4 nominal _
+type role T5 _
\ No newline at end of file
diff --git a/testsuite/tests/roles/should_compile/Roles1.stderr b/testsuite/tests/roles/should_compile/Roles1.stderr
new file mode 100644
index 0000000000..e56cfb44b3
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Roles1.stderr
@@ -0,0 +1,57 @@
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+  T1 :: * -> *
+  data T1 a
+      No C type associated
+      Roles: [nominal]
+      RecFlag NonRecursive, Promotable
+      = K1 :: forall a. a -> T1 a Stricts: _
+      FamilyInstance: none
+  T2 :: * -> *
+  data T2 a
+      No C type associated
+      Roles: [representational]
+      RecFlag NonRecursive, Promotable
+      = K2 :: forall a. a -> T2 a Stricts: _
+      FamilyInstance: none
+  T3 :: forall (k :: BOX). k -> *
+  data T3 (k::BOX) (a::k)
+      No C type associated
+      Roles: [nominal, phantom]
+      RecFlag NonRecursive, Not promotable
+      = K3 :: forall (k::BOX) (a::k). T3 k a
+      FamilyInstance: none
+  T4 :: (* -> *) -> * -> *
+  data T4 (a::* -> *) b
+      No C type associated
+      Roles: [nominal, nominal]
+      RecFlag NonRecursive, Not promotable
+      = K4 :: forall (a::* -> *) b. (a b) -> T4 a b Stricts: _
+      FamilyInstance: none
+  T5 :: * -> *
+  data T5 a
+      No C type associated
+      Roles: [representational]
+      RecFlag NonRecursive, Promotable
+      = K5 :: forall a. a -> T5 a Stricts: _
+      FamilyInstance: none
+  T6 :: forall (k :: BOX). k -> *
+  data T6 (k::BOX) (a::k)
+      No C type associated
+      Roles: [nominal, phantom]
+      RecFlag NonRecursive, Not promotable
+      = K6 :: forall (k::BOX) (a::k). T6 k a
+      FamilyInstance: none
+  T7 :: forall (k :: BOX). k -> * -> *
+  data T7 (k::BOX) (a::k) b
+      No C type associated
+      Roles: [nominal, phantom, representational]
+      RecFlag NonRecursive, Not promotable
+      = K7 :: forall (k::BOX) (a::k) b. b -> T7 k a b Stricts: _
+      FamilyInstance: none
+COERCION AXIOMS
+Dependent modules: []
+Dependent packages: [base, ghc-prim, integer-gmp]
+
+==================== Typechecker ====================
+
diff --git a/testsuite/tests/roles/should_compile/Roles13.hs b/testsuite/tests/roles/should_compile/Roles13.hs
new file mode 100644
index 0000000000..70d4c0c7d0
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Roles13.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving,
+             MultiParamTypeClasses, FunctionalDependencies #-}
+
+-- tests axiom roles
+
+module Roles13 where
+
+newtype Age = MkAge Int
+newtype Wrap a = MkWrap a
+
+convert :: Wrap Age -> Int
+convert (MkWrap (MkAge i)) = i
diff --git a/testsuite/tests/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr
new file mode 100644
index 0000000000..647e59ba51
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Roles13.stderr
@@ -0,0 +1,20 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core = {terms: 5, types: 9, coercions: 5}
+
+a :: Roles13.Wrap Roles13.Age -> Roles13.Wrap Roles13.Age
+[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType]
+a = \ (ds :: Roles13.Wrap Roles13.Age) -> ds
+
+Roles13.convert :: Roles13.Wrap Roles13.Age -> GHC.Types.Int
+[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType]
+Roles13.convert =
+  a
+  `cast` (<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/roles/should_compile/Roles2.hs b/testsuite/tests/roles/should_compile/Roles2.hs
new file mode 100644
index 0000000000..1ead5a4e94
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Roles2.hs
@@ -0,0 +1,9 @@
+module Roles2 where
+
+import GHC.Ptr
+
+-- these *must* have certain roles, or things break strangely
+-- see TcForeign
+
+data T1 a = K1 (IO a)
+data T2 a = K2 (FunPtr a)
diff --git a/testsuite/tests/roles/should_compile/Roles2.stderr b/testsuite/tests/roles/should_compile/Roles2.stderr
new file mode 100644
index 0000000000..ac7a94bbfa
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Roles2.stderr
@@ -0,0 +1,22 @@
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+  T1 :: * -> *
+  data T1 a
+      No C type associated
+      Roles: [representational]
+      RecFlag NonRecursive, Not promotable
+      = K1 :: forall a. (IO a) -> T1 a Stricts: _
+      FamilyInstance: none
+  T2 :: * -> *
+  data T2 a
+      No C type associated
+      Roles: [representational]
+      RecFlag NonRecursive, Not promotable
+      = K2 :: forall a. (FunPtr a) -> T2 a Stricts: _
+      FamilyInstance: none
+COERCION AXIOMS
+Dependent modules: []
+Dependent packages: [base, ghc-prim, integer-gmp]
+
+==================== Typechecker ====================
+
diff --git a/testsuite/tests/roles/should_compile/Roles3.hs b/testsuite/tests/roles/should_compile/Roles3.hs
new file mode 100644
index 0000000000..4c26f0d986
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Roles3.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}
+
+module Roles3 where
+
+class C1 a where
+  meth1 :: a -> a
+
+class C2 a b where
+  meth2 :: a ~ b => a -> b
+
+class C3 a b where
+  type F3 b
+  meth3 :: a -> F3 b -> F3 b
+
+type family F4 a
+
+class C4 a b where
+  meth4 :: a -> F4 b -> F4 b
+
+type Syn1 a = F4 a
+type Syn2 a = [a]
\ No newline at end of file
diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr
new file mode 100644
index 0000000000..5a074179db
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Roles3.stderr
@@ -0,0 +1,39 @@
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+  C1 :: * -> Constraint
+  class C1 a
+      Roles: [representational]
+      RecFlag NonRecursive
+      meth1 :: a -> a
+  C2 :: * -> * -> Constraint
+  class C2 a b
+      Roles: [nominal, nominal]
+      RecFlag NonRecursive
+      meth2 :: (~) * a b -> a -> b
+  C3 :: * -> * -> Constraint
+  class C3 a b
+      Roles: [representational, nominal]
+      RecFlag NonRecursive
+      type family F3 b :: *
+      meth3 :: a -> F3 b -> F3 b
+  C4 :: * -> * -> Constraint
+  class C4 a b
+      Roles: [representational, nominal]
+      RecFlag NonRecursive
+      meth4 :: a -> F4 b -> F4 b
+  F4 :: * -> *
+  type family F4 a :: *
+  Syn1 :: * -> *
+  type Syn1 a = F4 a
+  Syn2 :: * -> *
+  type Syn2 a = [a]
+COERCION AXIOMS
+  axiom Roles3.NTCo:C1 :: C1 a = a -> a
+  axiom Roles3.NTCo:C2 :: C2 a b = a ~ b => a -> b
+  axiom Roles3.NTCo:C3 :: C3 a b = a -> F3 b -> F3 b
+  axiom Roles3.NTCo:C4 :: C4 a b = a -> F4 b -> F4 b
+Dependent modules: []
+Dependent packages: [base, ghc-prim, integer-gmp]
+
+==================== Typechecker ====================
+
diff --git a/testsuite/tests/roles/should_compile/Roles4.hs b/testsuite/tests/roles/should_compile/Roles4.hs
new file mode 100644
index 0000000000..b5c404a84c
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Roles4.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE RoleAnnotations #-}
+
+module Roles4 where
+
+type role C1 nominal
+class C1 a where
+  meth1 :: a -> a
+
+type role C2 representational
+class C2 a where
+  meth2 :: a -> a
+
+type Syn1 a = [a]
+
+class C3 a where
+  meth3 :: a -> Syn1 a
+
diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr
new file mode 100644
index 0000000000..5da8f04b26
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Roles4.stderr
@@ -0,0 +1,28 @@
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+  C1 :: * -> Constraint
+  class C1 a
+      Roles: [nominal]
+      RecFlag NonRecursive
+      meth1 :: a -> a
+  C2 :: * -> Constraint
+  class C2 a
+      Roles: [representational]
+      RecFlag NonRecursive
+      meth2 :: a -> a
+  C3 :: * -> Constraint
+  class C3 a
+      Roles: [representational]
+      RecFlag NonRecursive
+      meth3 :: a -> Syn1 a
+  Syn1 :: * -> *
+  type Syn1 a = [a]
+COERCION AXIOMS
+  axiom Roles4.NTCo:C1 :: C1 a = a -> a
+  axiom Roles4.NTCo:C2 :: C2 a = a -> a
+  axiom Roles4.NTCo:C3 :: C3 a = a -> Syn1 a
+Dependent modules: []
+Dependent packages: [base, ghc-prim, integer-gmp]
+
+==================== Typechecker ====================
+
diff --git a/testsuite/tests/roles/should_compile/all.T b/testsuite/tests/roles/should_compile/all.T
new file mode 100644
index 0000000000..eaa398d619
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/all.T
@@ -0,0 +1,5 @@
+test('Roles1', only_ways('normal'), compile, ['-ddump-tc'])
+test('Roles2', only_ways('normal'), compile, ['-ddump-tc'])
+test('Roles3', only_ways('normal'), compile, ['-ddump-tc'])
+test('Roles4', only_ways('normal'), compile, ['-ddump-tc'])
+test('Roles13', only_ways('normal'), compile, ['-ddump-simpl -dsuppress-uniques'])
diff --git a/testsuite/tests/roles/should_fail/Makefile b/testsuite/tests/roles/should_fail/Makefile
new file mode 100644
index 0000000000..8f80de39c3
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Makefile
@@ -0,0 +1,9 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+.PHONY: Roles12
+
+Roles12:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c Roles12.hs-boot
+	-'$(TEST_HC)' $(TEST_HC_OPTS) -c Roles12.hs
diff --git a/testsuite/tests/roles/should_fail/Roles10.hs b/testsuite/tests/roles/should_fail/Roles10.hs
new file mode 100644
index 0000000000..af19bfdf31
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles10.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
+
+module Roles10 where
+
+type family F a
+type instance F Int = Bool
+type instance F Age = Char
+
+class C a where
+  meth :: a -> F a
+
+instance C Int where
+  meth = (> 0)
+
+newtype Age = MkAge Int
+  deriving C
\ No newline at end of file
diff --git a/testsuite/tests/roles/should_fail/Roles10.stderr b/testsuite/tests/roles/should_fail/Roles10.stderr
new file mode 100644
index 0000000000..756aaa2e00
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles10.stderr
@@ -0,0 +1,7 @@
+
+Roles10.hs:16:12:
+    Can't make a derived instance of ‛C Age’
+      (even with cunning newtype deriving):
+      it is not type-safe to use GeneralizedNewtypeDeriving on this class;
+      the last parameter of ‛C’ is at role Nominal
+    In the newtype declaration for ‛Age’
diff --git a/testsuite/tests/roles/should_fail/Roles11.hs b/testsuite/tests/roles/should_fail/Roles11.hs
new file mode 100644
index 0000000000..bc05477da9
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles11.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE GADTs, RoleAnnotations #-}
+
+module Roles11 where
+
+type role T2 representational
+data T2 a where
+  K2 :: T2 Int
+
diff --git a/testsuite/tests/roles/should_fail/Roles11.stderr b/testsuite/tests/roles/should_fail/Roles11.stderr
new file mode 100644
index 0000000000..ee15f99185
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles11.stderr
@@ -0,0 +1,5 @@
+
+Roles11.hs:6:1:
+    Role mismatch on variable a:
+      Annotation says representational but role nominal is required
+    In the data declaration for ‛T2’
diff --git a/testsuite/tests/roles/should_fail/Roles12.hs b/testsuite/tests/roles/should_fail/Roles12.hs
new file mode 100644
index 0000000000..875d105b78
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles12.hs
@@ -0,0 +1,5 @@
+module Roles12 where
+
+import {-# SOURCE #-} Roles12
+
+data T a
diff --git a/testsuite/tests/roles/should_fail/Roles12.hs-boot b/testsuite/tests/roles/should_fail/Roles12.hs-boot
new file mode 100644
index 0000000000..6a708d984a
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles12.hs-boot
@@ -0,0 +1,3 @@
+module Roles12 where
+
+data T a
\ No newline at end of file
diff --git a/testsuite/tests/roles/should_fail/Roles12.stderr b/testsuite/tests/roles/should_fail/Roles12.stderr
new file mode 100644
index 0000000000..42d63463e0
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles12.stderr
@@ -0,0 +1,15 @@
+
+Roles12.hs:5:6:
+    Type constructor ‛T’ has conflicting definitions in the module
+    and its hs-boot file
+    Main module: data T a
+                     No C type associated
+                     Roles: [phantom]
+                     RecFlag Recursive, Promotable
+                     =
+                     FamilyInstance: none
+    Boot file:   abstract(False) T a
+                     No C type associated
+                     Roles: [representational]
+                     RecFlag NonRecursive, Not promotable
+                     FamilyInstance: none
diff --git a/testsuite/tests/roles/should_fail/Roles5.hs b/testsuite/tests/roles/should_fail/Roles5.hs
new file mode 100644
index 0000000000..b75af75008
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles5.hs
@@ -0,0 +1,9 @@
+module Roles5 where
+
+data T a
+class C a
+type S a = Int
+
+type role T nominal
+type role C representational
+type role S phantom
\ No newline at end of file
diff --git a/testsuite/tests/roles/should_fail/Roles5.stderr b/testsuite/tests/roles/should_fail/Roles5.stderr
new file mode 100644
index 0000000000..c4907c89f6
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles5.stderr
@@ -0,0 +1,12 @@
+
+Roles5.hs:7:1:
+    Illegal role annotation for T;
+    did you intend to use RoleAnnotations?
+
+Roles5.hs:8:1:
+    Illegal role annotation for C;
+    did you intend to use RoleAnnotations?
+
+Roles5.hs:9:1:
+    Illegal role annotation for S;
+    they are allowed only for datatypes and classes.
diff --git a/testsuite/tests/roles/should_fail/Roles6.hs b/testsuite/tests/roles/should_fail/Roles6.hs
new file mode 100644
index 0000000000..c0ab9fafb2
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles6.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE RoleAnnotations #-}
+
+module Roles6 where
+
+data Foo a b = MkFoo (a b)
+
+type role Foo nominal representational phantom
+
diff --git a/testsuite/tests/roles/should_fail/Roles6.stderr b/testsuite/tests/roles/should_fail/Roles6.stderr
new file mode 100644
index 0000000000..3cca04d2a6
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles6.stderr
@@ -0,0 +1,15 @@
+
+Roles6.hs:5:1:
+    Role mismatch on variable a:
+      Annotation says nominal but role representational is required
+    In the data declaration for ‛Foo’
+
+Roles6.hs:5:1:
+    Role mismatch on variable b:
+      Annotation says representational but role nominal is required
+    In the data declaration for ‛Foo’
+
+Roles6.hs:7:1:
+    Wrong number of roles listed in role annotation;
+    Expected 2, got 3:
+      type role Foo nominal representational phantom
diff --git a/testsuite/tests/roles/should_fail/Roles7.hs b/testsuite/tests/roles/should_fail/Roles7.hs
new file mode 100644
index 0000000000..221b01a1c5
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles7.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE RoleAnnotations #-}
+
+module Roles7 where
+
+class Bar a
+type role Bar repesentational
+ -- spelling error intentional!
\ No newline at end of file
diff --git a/testsuite/tests/roles/should_fail/Roles7.stderr b/testsuite/tests/roles/should_fail/Roles7.stderr
new file mode 100644
index 0000000000..e4774f1aa8
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles7.stderr
@@ -0,0 +1,4 @@
+
+Roles7.hs:6:15:
+    Illegal role name ‛repesentational’
+    Perhaps you meant ‛representational’
diff --git a/testsuite/tests/roles/should_fail/Roles8.hs b/testsuite/tests/roles/should_fail/Roles8.hs
new file mode 100644
index 0000000000..396431cd50
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles8.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE RoleAnnotations, GADTs #-}
+
+module Roles8 where
+
+data T1 a = K1 a
+
+type role T1 nominal
+type role T1 nominal
+
+data T2 b = MkT2
+
+type role T2 representational
+type role T2 phantom
\ No newline at end of file
diff --git a/testsuite/tests/roles/should_fail/Roles8.stderr b/testsuite/tests/roles/should_fail/Roles8.stderr
new file mode 100644
index 0000000000..22f66f4667
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles8.stderr
@@ -0,0 +1,10 @@
+
+Roles8.hs:7:1:
+    Duplicate role annotations for ‛T1’:
+      type role T1 nominal -- written at Roles8.hs:7:1-20
+      type role T1 nominal -- written at Roles8.hs:8:1-20
+
+Roles8.hs:12:1:
+    Duplicate role annotations for ‛T2’:
+      type role T2 representational -- written at Roles8.hs:12:1-29
+      type role T2 phantom -- written at Roles8.hs:13:1-20
diff --git a/testsuite/tests/roles/should_fail/Roles9.hs b/testsuite/tests/roles/should_fail/Roles9.hs
new file mode 100644
index 0000000000..f8e134d5a1
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles9.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, RoleAnnotations #-}
+
+module Roles9 where
+
+type role C nominal
+class C a where
+  meth :: a -> a
+
+instance C Int where
+  meth = (+ 1)
+
+newtype Age = MkAge Int
+  deriving C
diff --git a/testsuite/tests/roles/should_fail/Roles9.stderr b/testsuite/tests/roles/should_fail/Roles9.stderr
new file mode 100644
index 0000000000..0cd02f9b5f
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/Roles9.stderr
@@ -0,0 +1,7 @@
+
+Roles9.hs:13:12:
+    Can't make a derived instance of ‛C Age’
+      (even with cunning newtype deriving):
+      it is not type-safe to use GeneralizedNewtypeDeriving on this class;
+      the last parameter of ‛C’ is at role Nominal
+    In the newtype declaration for ‛Age’
diff --git a/testsuite/tests/roles/should_fail/all.T b/testsuite/tests/roles/should_fail/all.T
new file mode 100644
index 0000000000..36f2d2e1a4
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/all.T
@@ -0,0 +1,10 @@
+test('Roles5', normal, compile_fail, [''])
+test('Roles6', normal, compile_fail, [''])
+test('Roles7', normal, compile_fail, [''])
+test('Roles8', normal, compile_fail, [''])
+test('Roles9', normal, compile_fail, [''])
+test('Roles10', normal, compile_fail, [''])
+test('Roles11', normal, compile_fail, [''])
+test('Roles12',
+     extra_clean(['Roles12.o-boot', 'Roles12.hi-boot']),
+     run_command, ['$MAKE --no-print-directory -s Roles12'])