Fix another obscure pattern-synonym crash

This one, discovered by Iceland Jack (Trac #14507), shows
that a pattern-bound coercion can show up in the argument
type(s) of the matcher of a pattern synonym.

The error message isn't great, but at least we now rightly
reject the program.

3 files changed, 28 insertions, 0 deletions

diff --git a/testsuite/tests/patsyn/should_fail/T14507.hs b/testsuite/tests/patsyn/should_fail/T14507.hs
new file mode 100644
index 0000000000..84166d0286
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T14507.hs
@@ -0,0 +1,19 @@
+{-# Language PatternSynonyms, ViewPatterns, GADTs, ConstraintKinds, RankNTypes, KindSignatures, PolyKinds, ScopedTypeVariables, DataKinds, TypeInType, TypeOperators, TypeApplications, TypeFamilies, TypeFamilyDependencies #-}
+
+module T14507 where
+
+import Type.Reflection
+import Data.Kind
+
+foo :: TypeRep a -> (Bool :~~: k, TypeRep a)
+foo rep = error "urk"
+
+type family SING :: k -> Type where
+  SING = (TypeRep :: Bool -> Type)
+
+pattern RepN :: forall (a::kk). () => Bool~kk => SING a -> TypeRep (a::kk)
+pattern RepN tr <- (foo -> ( HRefl :: Bool:~~:kk
+                           , tr :: TypeRep (a::Bool)))
+
+pattern SO x <- RepN (id -> x)
+
diff --git a/testsuite/tests/patsyn/should_fail/T14507.stderr b/testsuite/tests/patsyn/should_fail/T14507.stderr
new file mode 100644
index 0000000000..2ed89cbac6
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T14507.stderr
@@ -0,0 +1,8 @@
+
+T14507.hs:18:9: error:
+    • Iceland Jack!  Iceland Jack! Stop torturing me!
+      Pattern-bound variable x :: TypeRep a
+        has a type that mentions pattern-bound coercion: co_a2CF
+      Hint: use -fprint-explicit-coercions to see the coercions
+      Probable fix: add a pattern signature
+    • In the declaration for pattern synonym ‘SO’
diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T
index d2985d5e14..2b3b85bf28 100644
--- a/testsuite/tests/patsyn/should_fail/all.T
+++ b/testsuite/tests/patsyn/should_fail/all.T
@@ -41,3 +41,4 @@ test('T14114', normal, compile_fail, [''])
 test('T14380', normal, compile_fail, [''])
 test('T14498', normal, compile_fail, [''])
 test('T14552', normal, compile_fail, [''])
+test('T14507', normal, compile_fail, [''])