From 7a439e7b13f350e1ac6163f1bfa60e30924dbeea Mon Sep 17 00:00:00 2001
From: Richard Eisenberg <rae@cs.brynmawr.edu>
Date: Sun, 28 Oct 2018 16:06:17 -0400
Subject: [PATCH] Fix #15787 by squashing a coercion hole.

In type-incorrect code, we can sometimes let a coercion
hole make it through the zonker. If this coercion hole then
ends up in the environment (e.g., in the type of a data
constructor), then it causes trouble later.

This patch avoids trouble by substituting the coercion hole
for its representative CoVar. Really, any coercion would do,
but the CoVar was very handy.

test case: polykinds/T15787

(cherry picked from commit 4427315a65b25db22e1754d41b43dd4b782b022f)
---
 compiler/typecheck/TcHsSyn.hs           |  4 +++-
 testsuite/tests/polykinds/T15787.hs     | 19 +++++++++++++++++++
 testsuite/tests/polykinds/T15787.stderr |  6 ++++++
 testsuite/tests/polykinds/all.T         |  1 +
 4 files changed, 29 insertions(+), 1 deletion(-)
 create mode 100644 testsuite/tests/polykinds/T15787.hs
 create mode 100644 testsuite/tests/polykinds/T15787.stderr

diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs
index b3f9a691176f..986047bdedfd 100644
--- a/compiler/typecheck/TcHsSyn.hs
+++ b/compiler/typecheck/TcHsSyn.hs
@@ -1673,7 +1673,9 @@ zonkCoHole env hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })
                                    , text "Type-correct unfilled coercion hole"
                                      <+> ppr hole )
                          ; cv' <- zonkCoVar cv
-                         ; return $ mkHoleCo (hole { ch_co_var = cv' }) } }
+                         ; return $ mkCoVarCo cv' } }
+                             -- This will be an out-of-scope variable, but keeping
+                             -- this as a coercion hole led to #15787
 
 zonk_tycomapper :: TyCoMapper ZonkEnv TcM
 zonk_tycomapper = TyCoMapper
diff --git a/testsuite/tests/polykinds/T15787.hs b/testsuite/tests/polykinds/T15787.hs
new file mode 100644
index 000000000000..85e737a479ea
--- /dev/null
+++ b/testsuite/tests/polykinds/T15787.hs
@@ -0,0 +1,19 @@
+{-# Language RankNTypes #-}
+{-# Language TypeApplications #-}
+{-# Language DataKinds        #-}
+{-# Language PolyKinds        #-}
+{-# Language GADTs            #-}
+{-# Language TypeFamilies     #-}
+
+import Data.Kind
+
+class Ríki (ob :: Type) where
+ type Hom :: ob -> ob -> Type
+
+data
+  Kl_kind :: forall ob . (ob -> ob) -> ob -> Type where
+  Kl      :: k -> Kl_kind (m :: ob -> ob) k
+
+type family
+  UnKl (kl :: Kl_kind m k) = (res :: k) where
+  UnKl (Kl a) = a
diff --git a/testsuite/tests/polykinds/T15787.stderr b/testsuite/tests/polykinds/T15787.stderr
new file mode 100644
index 000000000000..6d368d5218c0
--- /dev/null
+++ b/testsuite/tests/polykinds/T15787.stderr
@@ -0,0 +1,6 @@
+
+T15787.hs:15:43: error:
+    • Expected kind ‘ob’, but ‘k’ has kind ‘*’
+    • In the second argument of ‘Kl_kind’, namely ‘k’
+      In the type ‘Kl_kind (m :: ob -> ob) k’
+      In the definition of data constructor ‘Kl’
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index 2d0f993b1760..53a33e3badd0 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -193,3 +193,4 @@ test('T15116a', normal, compile_fail, [''])
 test('T15170', normal, compile, [''])
 test('T14939', normal, compile, ['-O'])
 test('T15577', normal, compile_fail, ['-O'])
+test('T15787', normal, compile_fail, [''])
-- 
GitLab