Add test cases for Coercing recursive newtypes (#8503)
[ghc.git] / testsuite / tests / typecheck / should_run / TcCoercible.hs
index 4aa4ac1..855a133 100644 (file)
@@ -1,6 +1,6 @@
-{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE RoleAnnotations, StandaloneDeriving, FlexibleContexts, UndecidableInstances, GADTs #-}
 
-import GHC.Prim (coerce)
+import GHC.Prim (Coercible, coerce)
 import Data.Monoid (mempty, First(First), Last())
 
 newtype Age = Age Int deriving Show
@@ -18,7 +18,18 @@ data T f = T (f Int)
 -- It should be possible to coerce _under_ undersaturated newtypes
 newtype NonEtad a b = NonEtad (Either b a) deriving Show
 
+-- It should be possible to coerce recursive newtypes, in some situations
+-- (#8503)
+newtype Fix f = Fix (f (Fix f))
+deriving instance Show (f (Fix f)) => Show (Fix f)
 
+newtype FixEither a = FixEither (Either a (FixEither a)) deriving Show
+
+-- This ensures that explicitly given constraints are consulted, even 
+-- at higher depths
+data Oracle where Oracle :: Coercible (Fix (Either Age)) (Fix  (Either Int)) => Oracle
+foo :: Oracle -> Either Age (Fix (Either Age)) -> Fix (Either Int)
+foo Oracle = coerce
 
 main = do
     print (coerce $ one                       :: Age)
@@ -41,9 +52,15 @@ main = do
 
     printT (coerce $ (T (NonEtad (Right age)) :: T (NonEtad Age)) :: T (NonEtad Int))
 
-  where one = 1 :: Int
-        age = Age one
-        printT (T x) = print x
+    print (coerce $ (Fix (Left ()) :: Fix (Either ())) :: Either () (Fix (Either ())))
+    print (coerce $ (Left () :: Either () (Fix (Either ()))) :: Fix (Either ()))
 
+    print (coerce $ (FixEither (Left age) :: FixEither Age) :: Either Int (FixEither Int))
+    print (coerce $ (Left one :: Either Int (FixEither Age)) :: FixEither Age)
 
+    foo `seq` return ()
 
+
+  where one = 1 :: Int
+        age = Age one
+        printT (T x) = print x