Add regression tests for #18371

They have been fixed by !3959, I believe.
Fixes #18371.

3 files changed, 66 insertions, 0 deletions

diff --git a/testsuite/tests/pmcheck/should_compile/T18371.hs b/testsuite/tests/pmcheck/should_compile/T18371.hs
new file mode 100644
index 0000000000..517cb96bdd
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T18371.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# OPTIONS_GHC -Wincomplete-patterns #-}
+module Bug where
+
+import Data.Kind
+import Unsafe.Coerce
+
+type family Sing :: k -> Type
+
+class SingI a where
+  sing :: Sing a
+
+data SingInstance :: forall k. k -> Type where
+  SingInstance :: SingI a => SingInstance a
+
+newtype DI (a :: k) = Don'tInstantiate (SingI a => SingInstance a)
+
+singInstance :: forall k (a :: k). Sing a -> SingInstance a
+singInstance s = with_sing_i SingInstance
+  where
+    with_sing_i :: (SingI a => SingInstance a) -> SingInstance a
+    with_sing_i si = unsafeCoerce (Don'tInstantiate si) s
+
+{-# COMPLETE Sing #-}
+pattern Sing :: forall k (a :: k). () => SingI a => Sing a
+pattern Sing <- (singInstance -> SingInstance)
+  where Sing = sing
+
+-----
+
+data SBool :: Bool -> Type where
+  SFalse :: SBool False
+  STrue  :: SBool True
+type instance Sing = SBool
+
+f :: SBool b -> ()
+f Sing = ()
+
+g :: Sing (b :: Bool) -> ()
+g Sing = ()
diff --git a/testsuite/tests/pmcheck/should_compile/T18371b.hs b/testsuite/tests/pmcheck/should_compile/T18371b.hs
new file mode 100644
index 0000000000..cc5aa8683e
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T18371b.hs
@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TypeFamilies #-}
+module Lib where
+
+type family T
+
+pattern P :: T
+pattern P <- _
+{-# COMPLETE P #-}
+
+data U = U
+type instance T = U
+
+f :: U -> ()
+f P = ()
diff --git a/testsuite/tests/pmcheck/should_compile/all.T b/testsuite/tests/pmcheck/should_compile/all.T
index 862c5e134a..ba40866bcf 100644
--- a/testsuite/tests/pmcheck/should_compile/all.T
+++ b/testsuite/tests/pmcheck/should_compile/all.T
@@ -140,6 +140,10 @@ test('T18273', normal, compile,
      ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 test('T18341', normal, compile,
      ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T18371', normal, compile,
+     ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T18371b', normal, compile,
+     ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 test('T18478', collect_compiler_stats('bytes allocated',10), compile,
      ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 test('T18533', normal, compile,