[commit: ghc] ghc-7.10: Fix #10495. (b13c6fe)

[git at git.haskell.org]

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

On branch  : ghc-7.10
Link       : http://ghc.haskell.org/trac/ghc/changeset/b13c6fe9515964b2328d8a40bc9963d59cce801f/ghc

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

commit b13c6fe9515964b2328d8a40bc9963d59cce801f
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Mon Jun 8 15:57:33 2015 -0400

    Fix #10495.
    
    This change means that the intricate reasoning in TcErrors
    around getting messages just right for nominal equalities
    is skipped for representational equalities.


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

b13c6fe9515964b2328d8a40bc9963d59cce801f
 compiler/typecheck/TcErrors.hs                      | 13 ++++++++++---
 testsuite/tests/typecheck/should_fail/T10285.stderr |  5 ++++-
 testsuite/tests/typecheck/should_fail/T10495.hs     |  5 +++++
 testsuite/tests/typecheck/should_fail/all.T         |  1 +
 4 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index b07fbf9..21abffb 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -815,6 +815,7 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2
                             -- be oriented the other way round;
                             -- see TcCanonical.canEqTyVarTyVar
   || isSigTyVar tv1 && not (isTyVarTy ty2)
+  || ctEqRel ct == ReprEq  -- the cases below don't really apply to ReprEq
   = mkErrorMsg ctxt ct (vcat [ misMatchOrCND ctxt ct oriented ty1 ty2
                              , extraTyVarInfo ctxt tv1 ty2
                              , extra ])
@@ -938,13 +939,19 @@ misMatchOrCND ctxt ct oriented ty1 ty2
     isGivenCt ct
        -- If the equality is unconditionally insoluble
        -- or there is no context, don't report the context
-  = misMatchMsg oriented (ctEqRel ct) ty1 ty2
+  = misMatchMsg oriented eq_rel ty1 ty2
   | otherwise
-  = couldNotDeduce givens ([mkTcEqPred ty1 ty2], orig)
+  = couldNotDeduce givens ([eq_pred], orig)
   where
+    eq_rel = ctEqRel ct
     givens = [ given | given@(_, _, no_eqs, _) <- getUserGivens ctxt, not no_eqs]
              -- Keep only UserGivens that have some equalities
-    orig   = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2 }
+
+    (eq_pred, orig) = case eq_rel of
+      NomEq  -> ( mkTcEqPred ty1 ty2
+                , TypeEqOrigin { uo_actual = ty1, uo_expected = ty2 })
+      ReprEq -> ( mkCoerciblePred ty1 ty2
+                , CoercibleOrigin ty1 ty2 )
 
 couldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> SDoc
 couldNotDeduce givens (wanteds, orig)
diff --git a/testsuite/tests/typecheck/should_fail/T10285.stderr b/testsuite/tests/typecheck/should_fail/T10285.stderr
index 47cfbec..5b4af02 100644
--- a/testsuite/tests/typecheck/should_fail/T10285.stderr
+++ b/testsuite/tests/typecheck/should_fail/T10285.stderr
@@ -1,6 +1,9 @@
 
 T10285.hs:8:17:
-    Could not deduce (a ~ b)
+    Could not deduce (Coercible a b)
+      arising from trying to show that the representations of
+        ‘a’ and
+        ‘b’ are the same
     from the context (Coercible (N a) (N b))
       bound by a pattern with constructor
                  Coercion :: forall (k :: BOX) (a :: k) (b :: k).
diff --git a/testsuite/tests/typecheck/should_fail/T10495.hs b/testsuite/tests/typecheck/should_fail/T10495.hs
new file mode 100644
index 0000000..2573f51
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T10495.hs
@@ -0,0 +1,5 @@
+module T10495 where
+
+import Data.Coerce
+
+foo = coerce
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 95911d1..b6e5867 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -363,3 +363,4 @@ test('T9858b', normal, compile_fail, [''])
 test('T9858e', normal, compile_fail, [''])
 test('T10534', extra_clean(['T10534a.hi', 'T10534a.o']),
      multimod_compile_fail, ['T10534', '-v0'])
+test('T10495', normal, compile_fail, [''])