From 3054fd6df18ff32c4bf24d07d130102e52242c80 Mon Sep 17 00:00:00 2001
From: Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io>
Date: Tue, 29 Aug 2023 01:14:50 +0200
Subject: [PATCH] Add a regression test for #23903

The bug has been fixed by commit bad2f8b8aa8424.
---
 testsuite/tests/rep-poly/T23903.hs     | 21 +++++++++++++++++++++
 testsuite/tests/rep-poly/T23903.stderr | 10 ++++++++++
 testsuite/tests/rep-poly/all.T         |  1 +
 3 files changed, 32 insertions(+)
 create mode 100644 testsuite/tests/rep-poly/T23903.hs
 create mode 100644 testsuite/tests/rep-poly/T23903.stderr

diff --git a/testsuite/tests/rep-poly/T23903.hs b/testsuite/tests/rep-poly/T23903.hs
new file mode 100644
index 000000000000..6f204a029e68
--- /dev/null
+++ b/testsuite/tests/rep-poly/T23903.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE GHC2021, AllowAmbiguousTypes, DataKinds, MagicHash, TypeFamilies #-}
+module T23903 where
+
+import Data.Kind(Type)
+import GHC.Exts(Float#, Int#, RuntimeRep(FloatRep, IntRep), TYPE)
+
+type Rep :: Type -> RuntimeRep
+type family Rep t where
+  Rep Int = IntRep
+  Rep Float = FloatRep
+
+type Unbox :: forall (t :: Type) -> TYPE (Rep t)
+type family Unbox t where
+  Unbox Int = Int#
+  Unbox Float = Float#
+
+type family a #-> b where
+  a #-> b = Unbox a -> b
+
+f :: a #-> ()
+f _ = ()
diff --git a/testsuite/tests/rep-poly/T23903.stderr b/testsuite/tests/rep-poly/T23903.stderr
new file mode 100644
index 000000000000..72743fa15390
--- /dev/null
+++ b/testsuite/tests/rep-poly/T23903.stderr
@@ -0,0 +1,10 @@
+
+T23903.hs:21:1: error: [GHC-55287]
+    • The first pattern in the equation for ‘f’
+      does not have a fixed runtime representation.
+      Its type is:
+        p0 :: TYPE c0
+      Cannot unify ‘Rep a’ with the type variable ‘c0’
+      because the former is not a concrete ‘RuntimeRep’.
+    • The equation for ‘f’ has one value argument,
+        but its type ‘a #-> ()’ has none
diff --git a/testsuite/tests/rep-poly/all.T b/testsuite/tests/rep-poly/all.T
index 4515cf2bc742..32a1fa15fab7 100644
--- a/testsuite/tests/rep-poly/all.T
+++ b/testsuite/tests/rep-poly/all.T
@@ -36,6 +36,7 @@ test('T23051', normal, compile_fail, [''])
 test('T23153', normal, compile_fail, [''])
 test('T23154', normal, compile_fail, [''])
 test('T23176', normal, compile_fail, ['-XPartialTypeSignatures -fdefer-out-of-scope-variables'])
+test('T23903', normal, compile_fail, [''])
 
 test('EtaExpandDataCon', normal, compile, ['-O'])
 test('EtaExpandStupid1', normal, compile, ['-Wno-deprecated-flags'])
-- 
GitLab