[commit: ghc] wip/rae-new-coercible: Don't look under newtypes when unifying representationally. (2005d52)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/rae-new-coercible
Link       : http://ghc.haskell.org/trac/ghc/changeset/2005d52a4028ed78a99fd02e8055da1dc9fba64f/ghc

>---------------------------------------------------------------

commit 2005d52a4028ed78a99fd02e8055da1dc9fba64f
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Wed Dec 10 22:20:12 2014 -0500

    Don't look under newtypes when unifying representationally.


>---------------------------------------------------------------

2005d52a4028ed78a99fd02e8055da1dc9fba64f
 compiler/typecheck/TcCanonical.hs                           |  1 +
 testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs    |  6 ++----
 .../tests/typecheck/should_fail/TcCoercibleFail.stderr      | 13 ++++++++++---
 3 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index bc3e280..cfb2d89 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -1593,6 +1593,7 @@ unifyWanted loc role    orig_ty1 orig_ty2
            ; return (mkTcTyConAppCo role funTyCon [co_s,co_t]) }
     go (TyConApp tc1 tys1) (TyConApp tc2 tys2)
       | tc1 == tc2, isDecomposableTyCon tc1, tys1 `equalLength` tys2
+      , not (isNewTyCon tc1) || role == Nominal -- don't look under newtypes!
       = do { cos <- zipWith3M (unifyWanted loc) (tyConRolesX role tc1) tys1 tys2
            ; return (mkTcTyConAppCo role tc1 cos) }
     go (TyVarTy tv) ty2
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs
index 0431eee..c102da5 100644
--- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs
@@ -20,10 +20,8 @@ foo4 = coerce $ one :: Down Int
 newtype Void = Void Void
 foo5 = coerce :: Void -> ()
 
--- Do not test this; fills up memory
---newtype VoidBad a = VoidBad (VoidBad (a,a))
---foo5 = coerce :: (VoidBad ()) -> ()
-
+newtype VoidBad a = VoidBad (VoidBad (a,a))
+foo5' = coerce :: (VoidBad ()) -> ()
 
 -- This shoul fail with a context stack overflow
 newtype Fix f = Fix (f (Fix f))
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
index 6d1cee2..52d2c25 100644
--- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
@@ -39,15 +39,22 @@ TcCoercibleFail.hs:21:8:
     In the expression: coerce :: Void -> ()
     In an equation for ‘foo5’: foo5 = coerce :: Void -> ()
 
-TcCoercibleFail.hs:30:8:
+TcCoercibleFail.hs:24:9:
+    Couldn't match representation of type ‘()’
+                             with that of ‘VoidBad ()’
+    Relevant role signatures: type role VoidBad phantom
+    In the expression: coerce :: (VoidBad ()) -> ()
+    In an equation for ‘foo5'’: foo5' = coerce :: (VoidBad ()) -> ()
+
+TcCoercibleFail.hs:28:8:
     Context reduction stack overflow; size = 101
     Use -fcontext-stack=N to increase stack size to N
-      Coercible Int Age
+      Coercible (Fix (Either Int)) (Fix (Either Age))
     In the expression: coerce :: Fix (Either Int) -> Fix (Either Age)
     In an equation for ‘foo6’:
         foo6 = coerce :: Fix (Either Int) -> Fix (Either Age)
 
-TcCoercibleFail.hs:31:8:
+TcCoercibleFail.hs:29:8:
     Couldn't match representation of type ‘()’
                              with that of ‘Either Int (Fix (Either Int))’
     arising from trying to show that the representations of