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.

28 files changed, 302 insertions, 1 deletions

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, [''])