Add a regression test for #18609

The egregious performance hits are gone since !4050.
So we fix #18609.

3 files changed, 75 insertions, 0 deletions

diff --git a/testsuite/tests/pmcheck/should_compile/T18609.hs b/testsuite/tests/pmcheck/should_compile/T18609.hs
new file mode 100644
index 0000000000..50c77c9c81
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T18609.hs
@@ -0,0 +1,60 @@
+{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-}
+{-# LANGUAGE BangPatterns, GADTs, DataKinds, KindSignatures, EmptyCase #-}
+
+-- | All examples from https://arxiv.org/abs/1702.02281
+module GarrigueLeNormand where
+
+import Data.Kind
+
+data N = Z | S N
+
+data Plus :: N -> N -> N -> Type where
+  PlusO :: Plus Z a a
+  PlusS :: !(Plus a b c) -> Plus (S a) b (S c)
+
+data SMaybe a = SJust !a | SNothing
+
+trivial :: SMaybe (Plus (S Z) Z Z) -> ()
+trivial SNothing = ()
+
+trivial2 :: Plus (S Z) Z Z -> ()
+trivial2 x = case x of {}
+
+easy :: SMaybe (Plus Z (S Z) Z) -> ()
+easy SNothing = ()
+
+easy2 :: Plus Z (S Z) Z -> ()
+easy2 x = case x of {}
+
+harder :: SMaybe (Plus (S Z) (S Z) (S Z)) -> ()
+harder SNothing = ()
+
+harder2 :: Plus (S Z) (S Z) (S Z) -> ()
+harder2 x = case x of {}
+
+invZero :: Plus a b c -> Plus c d Z -> ()
+invZero !_     !_     | False = ()
+invZero  PlusO  PlusO = ()
+
+data T a where
+  A :: T Int
+  B :: T Bool
+  C :: T Char
+  D :: T Float
+
+data U a b c d where
+  U :: U Int Int Int Int
+
+f :: T a -> T b -> T c -> T d
+  -> U a b c d
+  -> ()
+f !_ !_ !_ !_ !_ | False = ()
+f  A  A  A  A  U = ()
+
+g :: T a -> T b -> T c -> T d
+  -> T e -> T f -> T g -> T h
+  -> U a b c d
+  -> U e f g h
+  -> ()
+g !_ !_ !_ !_ !_ !_ !_ !_ !_ !_ | False = ()
+g  A  A  A  A  A  A  A  A  U  U = ()
diff --git a/testsuite/tests/pmcheck/should_compile/T18609.stderr b/testsuite/tests/pmcheck/should_compile/T18609.stderr
new file mode 100644
index 0000000000..60a123dcfb
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T18609.stderr
@@ -0,0 +1,13 @@
+
+T18609.hs:36:25: warning: [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In an equation for ‘invZero’: invZero !_ !_ | False = ...
+
+T18609.hs:51:20: warning: [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In an equation for ‘f’: f !_ !_ !_ !_ !_ | False = ...
+
+T18609.hs:59:35: warning: [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In an equation for ‘g’:
+        g !_ !_ !_ !_ !_ !_ !_ !_ !_ !_ | False = ...
diff --git a/testsuite/tests/pmcheck/should_compile/all.T b/testsuite/tests/pmcheck/should_compile/all.T
index ba40866bcf..8d55ccbfee 100644
--- a/testsuite/tests/pmcheck/should_compile/all.T
+++ b/testsuite/tests/pmcheck/should_compile/all.T
@@ -150,6 +150,8 @@ test('T18533', normal, compile,
      ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 test('T18572', normal, compile,
      ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns'])
+test('T18609', normal, compile,
+     ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 test('T18670', normal, compile,
      ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 test('T18708', normal, compile,