[commit: ghc] ghc-8.2: Fix over-eager error suppression in TcErrors (8a07a52)

[git at git.haskell.org]

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

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/8a07a522ec9062886fd79b78d55924622ed72a69/ghc

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

commit 8a07a522ec9062886fd79b78d55924622ed72a69
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Oct 5 17:40:28 2017 +0100

    Fix over-eager error suppression in TcErrors
    
    See Note [Given insolubles] in TcRnTypes
    
    Fixes Trac #14325.
    
    (cherry picked from commit c81f66ccafdb4c6c7a09cfaf6819c8797c518491)


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

8a07a522ec9062886fd79b78d55924622ed72a69
 compiler/typecheck/TcRnTypes.hs                    | 24 ++++++++++++++++++++--
 testsuite/tests/typecheck/should_fail/T14325.hs    | 11 ++++++++++
 .../tests/typecheck/should_fail/T14325.stderr      |  9 ++++++++
 testsuite/tests/typecheck/should_fail/all.T        |  2 +-
 4 files changed, 43 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index cbc05b2..f38d255 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -2251,7 +2251,7 @@ trulyInsoluble :: Ct -> Bool
 -- Yuk!
 trulyInsoluble insol
   | isHoleCt insol = isOutOfScopeCt insol
-  | otherwise      = True
+  | otherwise      = not (isGivenCt insol) -- See Note [Given insolubles]
 
 instance Outputable WantedConstraints where
   ppr (WC {wc_simple = s, wc_impl = i, wc_insol = n})
@@ -2266,7 +2266,27 @@ ppr_bag doc bag
  | otherwise      = hang (doc <+> equals)
                        2 (foldrBag (($$) . ppr) empty bag)
 
-{-
+{- Note [Given insolubles]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider (Trac #14325, comment:)
+    class (a~b) => C a b
+
+    foo :: C a b => a -> b
+    foo x = x
+
+    hm3 :: C (f b) b => b -> f b
+    hm3 x = foo x
+
+From the [G] C (f b) b we get the insoluble [G] f b ~# b.  Then we we also
+get an unsolved [W] C b (f b).  If trulyInsouble is true of this, we'll
+set cec_suppress to True, and suppress reports of the [W] C b (f b).  But we
+may not report the insoluble [G] f b ~# b either (see Note [Given errors]
+in TcErrors), so we may fail to report anything at all!  Yikes.
+
+Bottom line: we must be certain to report anything trulyInsoluble.  Easiest
+way to guaranteed this is to make truly Insoluble false of Givens.
+
+
 ************************************************************************
 *                                                                      *
                 Implication constraints
diff --git a/testsuite/tests/typecheck/should_fail/T14325.hs b/testsuite/tests/typecheck/should_fail/T14325.hs
new file mode 100644
index 0000000..edb6038
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T14325.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE GADTs, MultiParamTypeClasses #-}
+
+module T14325 where
+
+class (a~b) => C a b
+
+foo :: C a b => a -> b
+foo x = x
+
+hm3 :: C (f b) b => b -> f b
+hm3 x = foo x
diff --git a/testsuite/tests/typecheck/should_fail/T14325.stderr b/testsuite/tests/typecheck/should_fail/T14325.stderr
new file mode 100644
index 0000000..1508c4a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T14325.stderr
@@ -0,0 +1,9 @@
+
+T14325.hs:11:9: error:
+    • Could not deduce (C b (f b)) arising from a use of ‘foo’
+      from the context: C (f b) b
+        bound by the type signature for:
+                   hm3 :: forall (f :: * -> *) b. C (f b) b => b -> f b
+        at T14325.hs:10:1-28
+    • In the expression: foo x
+      In an equation for ‘hm3’: hm3 x = foo x
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 2f75316..22d5ae0 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -437,4 +437,4 @@ test('T13677', normal, compile_fail, [''])
 test('T14000', normal, compile_fail, [''])
 test('T11672', normal, compile_fail, [''])
 test('T13929', normal, compile_fail, [''])
-
+test('T14325', normal, compile_fail, [''])