Tests for the Coercible class

Also see http://ghc.haskell.org/trac/ghc/wiki/NewtypeWrappers

12 files changed, 151 insertions, 0 deletions

diff --git a/testsuite/tests/typecheck/should_compile/TcCoercibleCompile.hs b/testsuite/tests/typecheck/should_compile/TcCoercibleCompile.hs
new file mode 100644
index 0000000000..cedf01326c
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/TcCoercibleCompile.hs
@@ -0,0 +1,9 @@
+{-# OPTIONS_GHC -fwarn-unused-imports  #-}
+
+import GHC.Prim (coerce)
+import Data.Monoid (First(First)) -- check whether the implicit use of First is noted
+
+main = print (coerce $ Just (1::Int)  :: First Int)
+
+
+
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index f2880710aa..eb0e934220 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -409,3 +409,4 @@ test('T7888', normal, compile, [''])
 test('T7891', normal, compile, [''])
 test('T7903', normal, compile, [''])
 test('TcTypeNatSimple', normal, compile, [''])
+test('TcCoercibleCompile', when(compiler_lt('ghc', '7.7'), skip), compile, [''])
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs
new file mode 100644
index 0000000000..54d5d2fc1a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE RoleAnnotations, RankNTypes, ScopedTypeVariables #-}
+
+import GHC.Prim (coerce, Coercible)
+import Data.Ord (Down)
+
+newtype Age = Age Int deriving Show
+
+data Map a@N b = Map a b deriving Show
+
+foo1 = coerce $ one :: ()
+
+foo2 :: forall m. Monad m => m Age
+foo2 = coerce $ (return one :: m Int)
+
+foo3 = coerce $ Map one () :: Map Age ()
+
+foo4 = coerce $ one :: Down Int
+
+newtype Void a = Void (Void (a,a))
+
+foo5 = coerce :: (Void ()) -> ()
+
+one :: Int
+one = 1
+
+main = return ()
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
new file mode 100644
index 0000000000..ecc9577782
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
@@ -0,0 +1,43 @@
+
+TcCoercibleFail.hs:10:8:
+    No instance for (Coercible Int ())
+      because ‛Int’ and ‛()’ are different types.
+      arising from a use of ‛coerce’
+    In the expression: coerce
+    In the expression: coerce $ one :: ()
+    In an equation for ‛foo1’: foo1 = coerce $ one :: ()
+
+TcCoercibleFail.hs:13:8:
+    Could not deduce (Coercible (m Int) (m Age))
+      because ‛m Int’ and ‛m Age’ are different types.
+      arising from a use of ‛coerce’
+    from the context (Monad m)
+      bound by the type signature for foo2 :: Monad m => m Age
+      at TcCoercibleFail.hs:12:9-34
+    In the expression: coerce
+    In the expression: coerce $ (return one :: m Int)
+    In an equation for ‛foo2’: foo2 = coerce $ (return one :: m Int)
+
+TcCoercibleFail.hs:15:8:
+    No instance for (Coercible (Map Int ()) (Map Age ()))
+      because the first type argument of ‛Map’ has role Nominal,
+      but the arguments ‛Int’ and ‛Age’ differ
+      arising from a use of ‛coerce’
+    In the expression: coerce
+    In the expression: coerce $ Map one () :: Map Age ()
+    In an equation for ‛foo3’: foo3 = coerce $ Map one () :: Map Age ()
+
+TcCoercibleFail.hs:17:8:
+    No instance for (Coercible Int (Down Int))
+    because the constructor of ‛Down’ is not imported
+      arising from a use of ‛coerce’
+    In the expression: coerce
+    In the expression: coerce $ one :: Down Int
+    In an equation for ‛foo4’: foo4 = coerce $ one :: Down Int
+
+TcCoercibleFail.hs:21:8:
+    No instance for (Coercible (Void ()) ())
+      because ‛Void’ is a recursive type constuctor
+      arising from a use of ‛coerce’
+    In the expression: coerce :: (Void ()) -> ()
+    In an equation for ‛foo5’: foo5 = coerce :: (Void ()) -> ()
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.hs b/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.hs
new file mode 100644
index 0000000000..13a3234fcc
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.hs
@@ -0,0 +1,5 @@
+import GHC.Prim (Coercible)
+
+instance Coercible () ()
+
+main = return ()
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.stderr
new file mode 100644
index 0000000000..f180a9a212
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.stderr
@@ -0,0 +1,5 @@
+
+TcCoercibleFail2.hs:3:10:
+    Illegal instance declaration for ‛Coercible () ()’
+      The class is abstract, manual instances are not permitted.
+    In the instance declaration for ‛Coercible () ()’
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFailSafe.hs b/testsuite/tests/typecheck/should_fail/TcCoercibleFailSafe.hs
new file mode 100644
index 0000000000..85f86b6e33
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFailSafe.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE RoleAnnotations, RankNTypes, ScopedTypeVariables, Safe #-}
+
+import GHC.Prim (coerce, Coercible)
+import Data.Ord (Down)
+
+newtype Age = Age Int deriving Show
+
+foo1 :: (Down Age -> Down Int)
+foo1 = coerce 
+
+main = return ()
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFailSafe.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFailSafe.stderr
new file mode 100644
index 0000000000..1675157e67
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFailSafe.stderr
@@ -0,0 +1,8 @@
+
+TcCoercibleFailSafe.hs:9:8:
+    No instance for (Coercible (Down Age) (Down Int))
+      because the constructor of ‛Down’ is not imported
+      as required in SafeHaskell mode
+      arising from a use of ‛coerce’
+    In the expression: coerce
+    In an equation for ‛foo1’: foo1 = coerce
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index f1aaee0ce6..d76f943b8a 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -316,3 +316,6 @@ test('T7809', normal, compile_fail, [''])
 test('T7989', normal, compile_fail, [''])
 test('T8142', normal, compile_fail, [''])
 test('T8262', normal, compile_fail, [''])
+test('TcCoercibleFail', when(compiler_lt('ghc', '7.7'), skip), compile_fail, [''])
+test('TcCoercibleFailSafe', when(compiler_lt('ghc', '7.7'), skip), compile_fail, [''])
+test('TcCoercibleFail2', when(compiler_lt('ghc', '7.7'), skip), compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_run/TcCoercible.hs b/testsuite/tests/typecheck/should_run/TcCoercible.hs
new file mode 100644
index 0000000000..6d5b3d7ccd
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/TcCoercible.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE RoleAnnotations #-}
+
+import GHC.Prim (coerce)
+import Data.Monoid (mempty, First(First), Last())
+
+newtype Age = Age Int deriving Show
+newtype Foo = Foo Age deriving Show
+newtype Bar = Bar Age deriving Show
+newtype Baz = Baz Bar deriving Show
+
+data Map a@N b = Map a b deriving Show
+
+main = do
+    print (coerce $ one                       :: Age)
+    print (coerce $ Age 1                     :: Int)
+    print (coerce $ Baz (Bar (Age 1))         :: Foo)
+
+    print (coerce (id::Bar->Bar) (Age 1)      :: Foo)
+    print (coerce Baz (Age 1)                 :: Foo)
+    print (coerce $ (Age 1, Foo (Age 1))      :: (Baz, Baz))
+
+    print (coerce $ Map one one               :: Map Int Age)
+
+    print (coerce $ Just one                  :: First Int)
+    print (coerce $ (mempty :: Last Age)      :: Last Int)
+
+  where one = 1 :: Int
+
+
+
diff --git a/testsuite/tests/typecheck/should_run/TcCoercible.stdout b/testsuite/tests/typecheck/should_run/TcCoercible.stdout
new file mode 100644
index 0000000000..6eb10ade03
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/TcCoercible.stdout
@@ -0,0 +1,9 @@
+Age 1
+1
+Foo (Age 1)
+Foo (Age 1)
+Foo (Age 1)
+(Baz (Bar (Age 1)),Baz (Bar (Age 1)))
+Map 1 (Age 1)
+First {getFirst = Just 1}
+Last {getLast = Nothing}
diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T
index b566c33f70..cc5052b6b8 100755
--- a/testsuite/tests/typecheck/should_run/all.T
+++ b/testsuite/tests/typecheck/should_run/all.T
@@ -111,3 +111,4 @@ test('T7748', normal, compile_and_run, [''])
 test('TcNullaryTC', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, [''])
 test('T7861', exit_code(1), compile_and_run, [''])
 test('TcTypeNatSimpleRun', normal, compile_and_run, [''])
+test('TcCoercible', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, [''])