From 341aeeaf9edd88080a40e9c8a1167f37dadb71f8 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simon.peytonjones@gmail.com>
Date: Thu, 13 Apr 2023 12:10:29 +0100
Subject: Stop if type constructors have kind errors

Otherwise we get knock-on errors, such as #23252.

This makes GHC fail a bit sooner, and I have not attempted to add
recovery code, to add a fake TyCon place of the erroneous one,
in an attempt to get more type errors in one pass.  We could
do that (perhaps) if there was a call for it.
---
 compiler/GHC/Tc/TyCl.hs                              |  8 +++++++-
 testsuite/tests/dependent/should_fail/T15743c.hs     |  2 +-
 testsuite/tests/dependent/should_fail/T15743c.stderr | 15 ---------------
 testsuite/tests/roles/should_fail/T23252.hs          | 12 ++++++++++++
 testsuite/tests/roles/should_fail/T23252.stderr      | 14 ++++++++++++++
 testsuite/tests/roles/should_fail/all.T              |  1 +
 6 files changed, 35 insertions(+), 17 deletions(-)
 create mode 100644 testsuite/tests/roles/should_fail/T23252.hs
 create mode 100644 testsuite/tests/roles/should_fail/T23252.stderr

diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 966b612a50..de6ef49225 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -248,7 +248,13 @@ tcTyClDecls tyclds kisig_env role_annots
   = do {    -- Step 1: kind-check this group and returns the final
             -- (possibly-polymorphic) kind of each TyCon and Class
             -- See Note [Kind checking for type and class decls]
-         (tc_tycons, kindless) <- kcTyClGroup kisig_env tyclds
+         (tc_tycons, kindless) <- checkNoErrs $
+                                  kcTyClGroup kisig_env tyclds
+            -- checkNoErrs: If the TyCons are ill-kinded, stop now.  Else we
+            -- can get follow-on errors. Example: #23252, where the TyCon
+            -- had an ill-scoped kind forall (d::k) k (a::k). blah
+            -- and that ill-scoped kind made role inference fall over.
+
        ; traceTc "tcTyAndCl generalized kinds" (vcat (map ppr_tc_tycon tc_tycons))
 
             -- Step 2: type-check all groups together, returning
diff --git a/testsuite/tests/dependent/should_fail/T15743c.hs b/testsuite/tests/dependent/should_fail/T15743c.hs
index eb8f68349f..72f599f035 100644
--- a/testsuite/tests/dependent/should_fail/T15743c.hs
+++ b/testsuite/tests/dependent/should_fail/T15743c.hs
@@ -8,4 +8,4 @@ import Data.Proxy
 data SimilarKind :: forall (c :: k) (d :: k). Proxy c -> Proxy d -> Type
 
 data T k (c :: k) (a :: Proxy c) b (x :: SimilarKind a b)
-data T2 k (c :: k) (a :: Proxy c) (b :: Proxy d) (x :: SimilarKind a b)
+
diff --git a/testsuite/tests/dependent/should_fail/T15743c.stderr b/testsuite/tests/dependent/should_fail/T15743c.stderr
index 1e7a46c2ab..ab44593b7b 100644
--- a/testsuite/tests/dependent/should_fail/T15743c.stderr
+++ b/testsuite/tests/dependent/should_fail/T15743c.stderr
@@ -13,18 +13,3 @@ T15743c.hs:10:1: error:
         (b :: Proxy d)
         (x :: SimilarKind a b)
     • In the data type declaration for ‘T’
-
-T15743c.hs:11:1: error:
-    • The kind of ‘T2’ is ill-scoped
-        Inferred kind: T2 :: forall (d :: k).
-                             forall k (c :: k) (a :: Proxy c) (b :: Proxy d) ->
-                             SimilarKind a b -> *
-      NB: Specified variables (namely: (d :: k)) always come first
-      Perhaps try this order instead:
-        k
-        (d :: k)
-        (c :: k)
-        (a :: Proxy c)
-        (b :: Proxy d)
-        (x :: SimilarKind a b)
-    • In the data type declaration for ‘T2’
diff --git a/testsuite/tests/roles/should_fail/T23252.hs b/testsuite/tests/roles/should_fail/T23252.hs
new file mode 100644
index 0000000000..b3b6b2ffd4
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/T23252.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE PolyKinds, DataKinds, ExplicitForAll #-}
+{-# LANGUAGE RoleAnnotations #-}
+
+module T15743 where
+
+import Data.Kind
+import Data.Proxy
+
+data SimilarKind :: forall (c :: k) (d :: k). Proxy c -> Proxy d -> Type
+
+data T2 k (c :: k) (a :: Proxy c) (b :: Proxy d) (x :: SimilarKind a b)
+type role T2 nominal nominal nominal nominal  -- Too few!
diff --git a/testsuite/tests/roles/should_fail/T23252.stderr b/testsuite/tests/roles/should_fail/T23252.stderr
new file mode 100644
index 0000000000..05ce387b6e
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/T23252.stderr
@@ -0,0 +1,14 @@
+T23252.hs:11:1: error:
+    • The kind of ‘T2’ is ill-scoped
+        Inferred kind: T2 :: forall (d :: k).
+                             forall k (c :: k) (a :: Proxy c) (b :: Proxy d) ->
+                             SimilarKind a b -> *
+      NB: Specified variables (namely: (d :: k)) always come first
+      Perhaps try this order instead:
+        k
+        (d :: k)
+        (c :: k)
+        (a :: Proxy c)
+        (b :: Proxy d)
+        (x :: SimilarKind a b)
+    • In the data type declaration for ‘T2’
diff --git a/testsuite/tests/roles/should_fail/all.T b/testsuite/tests/roles/should_fail/all.T
index eba86d4e03..5ac96c8e80 100644
--- a/testsuite/tests/roles/should_fail/all.T
+++ b/testsuite/tests/roles/should_fail/all.T
@@ -8,3 +8,4 @@ test('Roles12', [], makefile_test, [])
 test('T8773', normal, compile_fail, [''])
 test('T9204', [], makefile_test, [])
 test('RolesIArray', normal, compile_fail, [''])
+test('T23252', normal, compile_fail, [''])
-- 
cgit v1.2.1