From 1ed573a53ee454db240b9fb1a17e28c97b6eb53a Mon Sep 17 00:00:00 2001
From: Richard Eisenberg <rae@richarde.dev>
Date: Mon, 30 Jan 2023 17:39:18 -0500
Subject: Don't suppress *all* Wanteds

Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its
rewriters have unfilled coercion holes; see
Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint.

But if we thereby suppress *all* errors that's really confusing,
and as #22707 shows, GHC goes on without even realising that the
program is broken. Disaster.

This MR arranges to un-suppress them all if they all get suppressed.

Close #22707
---
 testsuite/tests/typecheck/should_fail/T22707.hs    | 22 ++++++++++++++++++++++
 .../tests/typecheck/should_fail/T22707.stderr      | 16 ++++++++++++++++
 testsuite/tests/typecheck/should_fail/all.T        |  1 +
 3 files changed, 39 insertions(+)
 create mode 100644 testsuite/tests/typecheck/should_fail/T22707.hs
 create mode 100644 testsuite/tests/typecheck/should_fail/T22707.stderr

(limited to 'testsuite/tests/typecheck/should_fail')

diff --git a/testsuite/tests/typecheck/should_fail/T22707.hs b/testsuite/tests/typecheck/should_fail/T22707.hs
new file mode 100644
index 0000000000..35b0817ec2
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T22707.hs
@@ -0,0 +1,22 @@
+module T22707 where
+
+newtype Cont o i a = Cont {runCont ::(a -> i) -> o }
+
+t1:: Cont (i2 -> o) i1 a -> Cont o i2 (a -> i1)
+t1 c = Cont $ \ati1tti2 -> (runCont c) (ati1tti2 $ \a -> evalCont (t1 c) >>== \ati1 -> return ati1 a )
+
+evalCont:: Cont o a a -> o
+evalCont c = (runCont c)id
+
+instance Monad (Cont p p) where
+  return a = Cont ($ a)
+  (>>=) = (>>==)
+
+class PMonad m where
+  (>>==):: m p q a -> (a -> m q r b) -> m p r b
+
+instance PMonad Cont where
+ (Cont cont) >>== afmb = Cont $ \bti -> cont $ \a -> (runCont . afmb) a bti
+
+main:: IO ()
+main = putStrLn "bug"
diff --git a/testsuite/tests/typecheck/should_fail/T22707.stderr b/testsuite/tests/typecheck/should_fail/T22707.stderr
new file mode 100644
index 0000000000..0620e5996f
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T22707.stderr
@@ -0,0 +1,16 @@
+
+T22707.hs:6:37: error: [GHC-18872]
+    • Couldn't match kind ‘*’ with ‘GHC.Types.RuntimeRep’
+      When matching types
+        p0 :: *
+        GHC.Types.LiftedRep :: GHC.Types.RuntimeRep
+      Expected: Cont o i1 a
+        Actual: Cont (i2 -> o) i1 a
+    • In the first argument of ‘runCont’, namely ‘c’
+      In the expression:
+        (runCont c)
+          (ati1tti2 $ \ a -> evalCont (t1 c) >>== \ ati1 -> return ati1 a)
+      In the second argument of ‘($)’, namely
+        ‘\ ati1tti2
+           -> (runCont c)
+                (ati1tti2 $ \ a -> evalCont (t1 c) >>== \ ati1 -> ...)’
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 430e8f409c..bf03352115 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -321,6 +321,7 @@ test('T7856', normal, compile_fail, [''])
 test('T7869', normal, compile_fail, [''])
 test('T7892', normal, compile_fail, [''])
 test('T7809', normal, compile_fail, [''])
+test('T22707', normal, compile_fail, [''])
 test('T7989', normal, compile_fail, [''])
 test('T8034', normal, compile_fail, [''])
 test('T8142', normal, compile_fail, [''])
-- 
cgit v1.2.1