Major Overhaul of Pattern Match Checking (Fixes #595)

This patch adresses several problems concerned with exhaustiveness and
redundancy checking of pattern matching. The list of improvements includes:

* Making the check type-aware (handles GADTs, Type Families, DataKinds, etc.).
  This fixes #4139, #3927, #8970 and other related tickets.

* Making the check laziness-aware. Cases that are overlapped but affect
  evaluation are issued now with "Patterns have inaccessible right hand side".
  Additionally, "Patterns are overlapped" is now replaced by "Patterns are
  redundant".

* Improved messages for literals. This addresses tickets #5724, #2204, etc.

* Improved reasoning concerning cases where simple and overloaded
  patterns are matched (See #322).

* Substantially improved reasoning for pattern guards. Addresses #3078.

* OverloadedLists extension does not break exhaustiveness checking anymore
  (addresses #9951). Note that in general this cannot be handled but if we know
  that an argument has type '[a]', we treat it as a list since, the instance of
  'IsList' gives the identity for both 'fromList' and 'toList'. If the type is
  not clear or is not the list type, then the check cannot do much still. I am
  a bit concerned about OverlappingInstances though, since one may override the
  '[a]' instance with e.g. an '[Int]' instance that is not the identity.

* Improved reasoning for nested pattern matching (partial solution). Now we
  propagate type and (some) term constraints deeper when checking, so we can
  detect more inconsistencies. For example, this is needed for #4139.

I am still not satisfied with several things but I would like to address at
least the following before the next release:
    Term constraints are too many and not printed for non-exhaustive matches
(with the exception of literals). This sometimes results in two identical (in
appearance) uncovered warnings. Unless we actually show their difference, I
would like to have a single warning.

45 files changed, 531 insertions, 0 deletions

diff --git a/testsuite/tests/pmcheck/Makefile b/testsuite/tests/pmcheck/Makefile
new file mode 100644
index 0000000000..9a36a1c5fe
--- /dev/null
+++ b/testsuite/tests/pmcheck/Makefile
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/pmcheck/should_compile/Makefile b/testsuite/tests/pmcheck/should_compile/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/pmcheck/should_compile/T2006.hs b/testsuite/tests/pmcheck/should_compile/T2006.hs
new file mode 100644
index 0000000000..00cd783fb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T2006.hs
@@ -0,0 +1,13 @@
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+{-# LANGUAGE GADTs #-}
+
+module T2006 where
+
+data Expr a vs where
+    EPrim   :: String -> a -> Expr a vs
+    EVar    :: Expr a (a,vs)
+
+interpret :: Expr a () -> a
+interpret (EPrim _ a) = a
+-- interpret EVar = error "unreachable"
+
diff --git a/testsuite/tests/pmcheck/should_compile/T2006.stderr b/testsuite/tests/pmcheck/should_compile/T2006.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T2006.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/T2204.hs b/testsuite/tests/pmcheck/should_compile/T2204.hs
new file mode 100644
index 0000000000..0f2dbec7e0
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T2204.hs
@@ -0,0 +1,9 @@
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+
+module T2204 where
+
+f :: String -> Int
+f "01" = 0
+
+g :: Int -> Int
+g 0 = 0
diff --git a/testsuite/tests/pmcheck/should_compile/T2204.stderr b/testsuite/tests/pmcheck/should_compile/T2204.stderr
new file mode 100644
index 0000000000..e6ad7cf9ae
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T2204.stderr
@@ -0,0 +1,14 @@
+T2204.hs:6:1: warning:
+    Pattern match(es) are non-exhaustive
+    In an equation for ‘f’:
+        Patterns not matched:
+            ('0':'1':_:_)
+            ('0':p:_) where p is not one of {'1'}
+            ['0']
+            (p:_) where p is not one of {'0'}
+            ...
+
+T2204.hs:9:1: warning:
+    Pattern match(es) are non-exhaustive
+    In an equation for ‘g’:
+        Patterns not matched: p where p is not one of {0}
diff --git a/testsuite/tests/pmcheck/should_compile/T3078.hs b/testsuite/tests/pmcheck/should_compile/T3078.hs
new file mode 100644
index 0000000000..f6d6362faf
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T3078.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE PatternGuards #-}
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+
+module T3078 where
+
+data T = A Int | B Int
+
+funny :: T -> Int
+funny t = n
+    where
+      n | A x <- t = x
+        | B x <- t = x
diff --git a/testsuite/tests/pmcheck/should_compile/T3078.stderr b/testsuite/tests/pmcheck/should_compile/T3078.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T3078.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/T322.hs b/testsuite/tests/pmcheck/should_compile/T322.hs
new file mode 100644
index 0000000000..3b8f1a9c7c
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T322.hs
@@ -0,0 +1,29 @@
+{-# OPTIONS -fwarn-incomplete-patterns -fwarn-overlapping-patterns -Werror #-}
+
+module T322 where
+
+instance (Num a) => Num (Maybe a) where
+  (Just a) + (Just b) = Just (a + b)
+  _ + _ = Nothing
+
+  (Just a) - (Just b) = Just (a - b)
+  _ - _ = Nothing
+
+  (Just a) * (Just b) = Just (a * b)
+  _ * _ = Nothing
+
+  negate (Just a) = Just (negate a)
+  negate _ = Nothing
+
+  abs (Just a) = Just (abs a)
+  abs _ = Nothing
+
+  signum (Just a) = Just (signum a)
+  signum _ = Nothing
+
+  fromInteger = Just . fromInteger
+
+f :: Maybe Int -> Int
+f 1       = 1
+f Nothing = 2
+f _       = 3
diff --git a/testsuite/tests/pmcheck/should_compile/T322.stderr b/testsuite/tests/pmcheck/should_compile/T322.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T322.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/T366.hs b/testsuite/tests/pmcheck/should_compile/T366.hs
new file mode 100644
index 0000000000..f0090acfe3
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T366.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -XGADTs -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+
+module T366 where
+
+data T a where
+  C1 :: T Char
+  C2 :: T Float
+
+exhaustive :: T Char -> Char
+exhaustive C1 = ' '
diff --git a/testsuite/tests/pmcheck/should_compile/T366.stderr b/testsuite/tests/pmcheck/should_compile/T366.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T366.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/T3927.hs b/testsuite/tests/pmcheck/should_compile/T3927.hs
new file mode 100644
index 0000000000..f1ec01ee7f
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T3927.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE GADTs #-}
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+
+module T3927 where
+
+data T a where
+  T1 :: T Int
+  T2 :: T Bool
+
+-- f1 is exhaustive
+f1 :: T a -> T a -> Bool
+f1 T1 T1 = True
+f1 T2 T2 = False
diff --git a/testsuite/tests/pmcheck/should_compile/T3927.stderr b/testsuite/tests/pmcheck/should_compile/T3927.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T3927.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/T3927a.hs b/testsuite/tests/pmcheck/should_compile/T3927a.hs
new file mode 100644
index 0000000000..62fb68b607
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T3927a.hs
@@ -0,0 +1,15 @@
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+{-# LANGUAGE GADTs, TypeFamilies #-}
+
+module T3927a where
+
+type family F a
+type instance F a = ()
+
+data Foo a where
+  FooA :: Foo ()
+  FooB :: Foo Int
+
+f :: a -> Foo (F a) -> () -- F a can only be () so only FooA is accepted
+f _ FooA = ()
+
diff --git a/testsuite/tests/pmcheck/should_compile/T3927a.stderr b/testsuite/tests/pmcheck/should_compile/T3927a.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T3927a.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/T3927b.hs b/testsuite/tests/pmcheck/should_compile/T3927b.hs
new file mode 100644
index 0000000000..d2eb8cd6cb
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T3927b.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+
+module T3927b where
+
+import Data.Proxy
+import GHC.Exts
+
+data Message
+
+data SocketType = Dealer | Push | Pull
+
+data SocketOperation = Read | Write
+
+type family Restrict (a :: SocketOperation) (as :: [SocketOperation]) :: Constraint where
+    Restrict a (a ': as) = ()
+    Restrict x (a ': as) = Restrict x as
+    Restrict x '[] = ("Error!" ~ "Tried to apply a restricted type!")
+
+type family Implements (t :: SocketType) :: [SocketOperation] where
+    Implements Dealer = ['Read, Write]
+    Implements Push = '[Write]
+    Implements Pull = '[ 'Read]
+
+data SockOp :: SocketType -> SocketOperation -> * where
+    SRead :: SockOp sock 'Read
+    SWrite :: SockOp sock Write
+
+data Socket :: SocketType -> * where
+    Socket :: proxy sock
+           -> (forall op . Restrict op (Implements sock) => SockOp sock op -> Operation op)
+           -> Socket sock
+
+type family Operation (op :: SocketOperation) :: * where
+    Operation 'Read = IO Message
+    Operation Write = Message -> IO ()
+
+class Restrict 'Read (Implements t) => Readable t where
+    readSocket :: Socket t -> Operation 'Read
+    readSocket (Socket _ f) = f (SRead :: SockOp t 'Read)
+
+instance Readable Dealer
+
+type family Writable (t :: SocketType) :: Constraint where
+    Writable Dealer = ()
+    Writable Push = ()
+
+dealer :: Socket Dealer
+dealer = Socket (Proxy :: Proxy Dealer) f
+  where
+    f :: Restrict op (Implements Dealer) => SockOp Dealer op -> Operation op
+    f SRead = undefined
+    f SWrite = undefined
+
+push :: Socket Push
+push = Socket (Proxy :: Proxy Push) f
+  where
+    f :: Restrict op (Implements Push) => SockOp Push op -> Operation op
+    f SWrite = undefined
+
+pull :: Socket Pull
+pull = Socket (Proxy :: Proxy Pull) f
+  where
+    f :: Restrict op (Implements Pull) => SockOp Pull op -> Operation op
+    f SRead = undefined
+
+foo :: IO Message
+foo = readSocket dealer
diff --git a/testsuite/tests/pmcheck/should_compile/T3927b.stderr b/testsuite/tests/pmcheck/should_compile/T3927b.stderr
new file mode 100644
index 0000000000..fb4449ced9
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T3927b.stderr
@@ -0,0 +1,39 @@
+T3927b.hs:58:5: warning:
+    • Redundant constraint: Restrict op (Implements 'Dealer)
+    • In the type signature for:
+           f :: Restrict op (Implements 'Dealer) =>
+                SockOp 'Dealer op -> Operation op
+      In an equation for ‘dealer’:
+          dealer
+            = Socket (Proxy :: Proxy Dealer) f
+            where
+                f ::
+                  Restrict op (Implements Dealer) => SockOp Dealer op -> Operation op
+                f SRead = undefined
+                f SWrite = undefined
+
+T3927b.hs:65:5: warning:
+    • Redundant constraint: Restrict op (Implements 'Push)
+    • In the type signature for:
+           f :: Restrict op (Implements 'Push) =>
+                SockOp 'Push op -> Operation op
+      In an equation for ‘push’:
+          push
+            = Socket (Proxy :: Proxy Push) f
+            where
+                f ::
+                  Restrict op (Implements Push) => SockOp Push op -> Operation op
+                f SWrite = undefined
+
+T3927b.hs:71:5: warning:
+    • Redundant constraint: Restrict op (Implements 'Pull)
+    • In the type signature for:
+           f :: Restrict op (Implements 'Pull) =>
+                SockOp 'Pull op -> Operation op
+      In an equation for ‘pull’:
+          pull
+            = Socket (Proxy :: Proxy Pull) f
+            where
+                f ::
+                  Restrict op (Implements Pull) => SockOp Pull op -> Operation op
+                f SRead = undefined
diff --git a/testsuite/tests/pmcheck/should_compile/T4139.hs b/testsuite/tests/pmcheck/should_compile/T4139.hs
new file mode 100644
index 0000000000..4f6d4abab5
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T4139.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE GADTs #-}
+{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
+
+module T4139 where
+
+data F a where
+  FInt :: F Int
+  FBool :: F Bool
+
+class Baz a where
+  baz :: F a -> G a
+instance Baz Int where
+  baz _ = GInt
+instance Baz Bool where
+  baz _ = GBool
+
+data G a where
+  GInt :: G Int
+  GBool :: G Bool
+
+bar :: Baz a => F a -> ()
+bar a@(FInt) =
+  case baz a of
+    GInt -> ()
+    -- GBool -> ()
+bar _ = ()
+
+
diff --git a/testsuite/tests/pmcheck/should_compile/T4139.stderr b/testsuite/tests/pmcheck/should_compile/T4139.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T4139.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/T6124.hs b/testsuite/tests/pmcheck/should_compile/T6124.hs
new file mode 100644
index 0000000000..e4f18b3364
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T6124.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE GADTs #-}
+{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
+
+module T6124 where
+
+newtype A = MkA Int
+newtype B = MkB Char
+
+data T a where
+    A :: T A
+    B :: T B
+
+f :: T A -> A
+f A = undefined
diff --git a/testsuite/tests/pmcheck/should_compile/T6124.stderr b/testsuite/tests/pmcheck/should_compile/T6124.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T6124.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/T7669.hs b/testsuite/tests/pmcheck/should_compile/T7669.hs
new file mode 100644
index 0000000000..6744d8afb0
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T7669.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE EmptyCase #-}
+{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
+
+module T7669 where
+
+data Void
+
+foo :: Void -> ()
+foo x = case x of {}
diff --git a/testsuite/tests/pmcheck/should_compile/T7669.stderr b/testsuite/tests/pmcheck/should_compile/T7669.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T7669.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/T8970.hs b/testsuite/tests/pmcheck/should_compile/T8970.hs
new file mode 100644
index 0000000000..37e3756918
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T8970.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE DataKinds, KindSignatures, GADTs, TypeFamilies #-}
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+
+module T8970 where
+
+data K = Foo
+       | Bar
+
+data D1 :: K -> * where
+    F1 :: D1 Foo
+    B1 :: D1 Bar
+
+class C (a :: K -> *) where
+    data D2 a :: K -> *
+    foo :: a k -> D2 a k -> Bool
+
+instance C D1 where
+    data D2 D1 k where
+              F2 :: D2 D1 Foo
+              B2 :: D2 D1 Bar
+    foo F1 F2 = True
+    foo B1 B2 = True
diff --git a/testsuite/tests/pmcheck/should_compile/T8970.stderr b/testsuite/tests/pmcheck/should_compile/T8970.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T8970.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/T9951.hs b/testsuite/tests/pmcheck/should_compile/T9951.hs
new file mode 100644
index 0000000000..f1740fd733
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T9951.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+
+module T9951 where
+
+f :: [a] -> ()
+f x = case x of
+  [] -> ()
+  (_:_) -> ()
+
diff --git a/testsuite/tests/pmcheck/should_compile/T9951.stderr b/testsuite/tests/pmcheck/should_compile/T9951.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T9951.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/T9951b.hs b/testsuite/tests/pmcheck/should_compile/T9951b.hs
new file mode 100644
index 0000000000..6ae875dfbb
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T9951b.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+
+module T9951b where
+
+f :: String -> Bool
+f "ab" = True
diff --git a/testsuite/tests/pmcheck/should_compile/T9951b.stderr b/testsuite/tests/pmcheck/should_compile/T9951b.stderr
new file mode 100644
index 0000000000..6a9d0ce112
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T9951b.stderr
@@ -0,0 +1,9 @@
+T9951b.hs:7:1: warning:
+    Pattern match(es) are non-exhaustive
+    In an equation for ‘f’:
+        Patterns not matched:
+            ('a':'b':_:_)
+            ('a':p:_) where p is not one of {'b'}
+            ['a']
+            (p:_) where p is not one of {'a'}
+            ...
diff --git a/testsuite/tests/pmcheck/should_compile/all.T b/testsuite/tests/pmcheck/should_compile/all.T
new file mode 100644
index 0000000000..3aac879976
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/all.T
@@ -0,0 +1,35 @@
+
+# Tests for pattern match checker (coverage and exhaustiveness)
+
+# Just do the normal way...
+def f( name, opts ):
+  opts.only_ways = ['normal']
+
+setTestOpts(f)
+
+# Bug reports / feature requests
+test('T2006', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T2204', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T3078', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T322',  only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T366',  only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T3927a',only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T3927b',only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T3927', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T4139', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T6124', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T7669', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T8970', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T9951b',only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T9951', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+
+# Other tests
+test('pmc001', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('pmc002', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('pmc003', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('pmc004', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('pmc005', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('pmc006', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('pmc007', only_compiler_types(['ghc']), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+
+
diff --git a/testsuite/tests/pmcheck/should_compile/pmc001.hs b/testsuite/tests/pmcheck/should_compile/pmc001.hs
new file mode 100644
index 0000000000..89cb484349
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc001.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE TypeFamilies, GADTs #-}
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+
+module PMC001 where
+
+data family T a
+
+data instance T [a] where
+  MkT1 :: T [Int]
+  MkT2 :: Char -> T [Char]
+  MkT3 :: T [a]
+
+f :: T [a] -> T [a] -> Bool
+f MkT1     MkT1     = True
+f (MkT2 _) (MkT2 _) = True
+f MkT3     MkT3     = True
+
+g :: T [a] -> T [a] -> Bool
+g x y
+  | MkT1     <- x, MkT1     <- y = True
+  | (MkT2 _) <- x, (MkT2 _) <- y = True
+  | MkT3     <- x, MkT3     <- y = True
diff --git a/testsuite/tests/pmcheck/should_compile/pmc001.stderr b/testsuite/tests/pmcheck/should_compile/pmc001.stderr
new file mode 100644
index 0000000000..c6145432f0
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc001.stderr
@@ -0,0 +1,17 @@
+pmc001.hs:14:1: warning:
+    Pattern match(es) are non-exhaustive
+    In an equation for ‘f’:
+        Patterns not matched:
+            MkT3 (MkT2 _)
+            MkT3 MkT1
+            (MkT2 _) MkT3
+            MkT1 MkT3
+
+pmc001.hs:19:1: warning:
+    Pattern match(es) are non-exhaustive
+    In an equation for ‘g’:
+        Patterns not matched:
+            MkT3 (MkT2 _)
+            MkT3 MkT1
+            (MkT2 _) MkT3
+            MkT1 MkT3
diff --git a/testsuite/tests/pmcheck/should_compile/pmc002.hs b/testsuite/tests/pmcheck/should_compile/pmc002.hs
new file mode 100644
index 0000000000..ae823069c5
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc002.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+
+module PMC002 where
+
+f :: [a] -> Bool
+f []              = True
+f x  | (_:_) <- x = False -- exhaustive
diff --git a/testsuite/tests/pmcheck/should_compile/pmc002.stderr b/testsuite/tests/pmcheck/should_compile/pmc002.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc002.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/pmc003.hs b/testsuite/tests/pmcheck/should_compile/pmc003.hs
new file mode 100644
index 0000000000..dd5a8681c7
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc003.hs
@@ -0,0 +1,9 @@
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+
+module PMC003 where
+
+f :: Bool -> Bool -> ()
+f _    False = ()
+f True False = ()
+f _    _     = ()
+
diff --git a/testsuite/tests/pmcheck/should_compile/pmc003.stderr b/testsuite/tests/pmcheck/should_compile/pmc003.stderr
new file mode 100644
index 0000000000..4006b0c042
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc003.stderr
@@ -0,0 +1,3 @@
+pmc003.hs:6:1: warning:
+    Pattern match(es) have inaccessible right hand side
+    In an equation for ‘f’: f True False = ...
diff --git a/testsuite/tests/pmcheck/should_compile/pmc004.hs b/testsuite/tests/pmcheck/should_compile/pmc004.hs
new file mode 100644
index 0000000000..90a60c823a
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc004.hs
@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+{-# LANGUAGE GADTs #-}
+
+module PMC004 where
+
+data F a where
+  F1 :: F Int
+  F2 :: F Bool
+
+data G a where
+  G1 :: G Int
+  G2 :: G Char
+
+h :: F a -> G a -> ()
+h F1 G1 = ()
+h _  G1 = ()
diff --git a/testsuite/tests/pmcheck/should_compile/pmc004.stderr b/testsuite/tests/pmcheck/should_compile/pmc004.stderr
new file mode 100644
index 0000000000..53f590dd4e
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc004.stderr
@@ -0,0 +1,3 @@
+pmc004.hs:15:1: warning:
+    Pattern match(es) have inaccessible right hand side
+    In an equation for ‘h’: h _ G1 = ...
diff --git a/testsuite/tests/pmcheck/should_compile/pmc005.hs b/testsuite/tests/pmcheck/should_compile/pmc005.hs
new file mode 100644
index 0000000000..d05b2d435c
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc005.hs
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+{-# LANGUAGE GADTs #-}
+
+module PMC005 where
+
+data T a where
+  TList :: T [a]
+  TBool :: T Bool
+
+foo :: T c -> T c -> ()
+foo TList _     = ()
+foo _     TList = ()
diff --git a/testsuite/tests/pmcheck/should_compile/pmc005.stderr b/testsuite/tests/pmcheck/should_compile/pmc005.stderr
new file mode 100644
index 0000000000..940dd3a1e9
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc005.stderr
@@ -0,0 +1,7 @@
+pmc005.hs:11:1: warning:
+    Pattern match(es) have inaccessible right hand side
+    In an equation for ‘foo’: foo _ TList = ...
+
+pmc005.hs:11:1: warning:
+    Pattern match(es) are non-exhaustive
+    In an equation for ‘foo’: Patterns not matched: TBool TBool
diff --git a/testsuite/tests/pmcheck/should_compile/pmc006.hs b/testsuite/tests/pmcheck/should_compile/pmc006.hs
new file mode 100644
index 0000000000..7099dea23d
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc006.hs
@@ -0,0 +1,22 @@
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+
+module PMC006 where
+
+len :: [a] -> Int
+len xs = case xs of
+           []     -> 0
+           (_:ys) -> case () of
+                       () | (_:_) <- xs -> 1 + len ys
+
+-- -- we would like these to work too but they don't yet
+--
+-- len :: [a] -> Int
+-- len [] = 0
+-- len xs = case xs of
+--            (_:ys) -> 1 + len ys
+--
+-- len :: [a] -> Int
+-- len xs = case xs of
+--            [] -> 0
+--            ys -> case ys of
+--                    (_:zs) -> 1 + len zs
diff --git a/testsuite/tests/pmcheck/should_compile/pmc006.stderr b/testsuite/tests/pmcheck/should_compile/pmc006.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc006.stderr
diff --git a/testsuite/tests/pmcheck/should_compile/pmc007.hs b/testsuite/tests/pmcheck/should_compile/pmc007.hs
new file mode 100644
index 0000000000..301cdbbac2
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc007.hs
@@ -0,0 +1,20 @@
+{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module PMC007 where
+
+-- overloaded
+f "ab" = ()
+f "ac" = ()
+
+-- non-overloaded
+g :: String -> ()
+g "ab" = ()
+g "ac" = ()
+
+-- non-overloaded due to type inference
+h :: String -> ()
+h s = let s' = s
+      in  case s' of
+            "ab" -> ()
+            "ac" -> ()
diff --git a/testsuite/tests/pmcheck/should_compile/pmc007.stderr b/testsuite/tests/pmcheck/should_compile/pmc007.stderr
new file mode 100644
index 0000000000..bb011be5aa
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/pmc007.stderr
@@ -0,0 +1,24 @@
+pmc007.hs:7:1: warning:
+    Pattern match(es) are non-exhaustive
+    In an equation for ‘f’:
+        Patterns not matched: p where p is not one of {"ac", "ab"}
+
+pmc007.hs:12:1: warning:
+    Pattern match(es) are non-exhaustive
+    In an equation for ‘g’:
+        Patterns not matched:
+            ('a':'b':_:_)
+            ('a':'c':_:_)
+            ('a':p:_) where p is not one of {'c', 'b'}
+            ['a']
+            ...
+
+pmc007.hs:18:11: warning:
+    Pattern match(es) are non-exhaustive
+    In a case alternative:
+        Patterns not matched:
+            ('a':'b':_:_)
+            ('a':'c':_:_)
+            ('a':p:_) where p is not one of {'c', 'b'}
+            ['a']
+            ...