diff options
Diffstat (limited to 'testsuite/tests/pmcheck/should_compile')
44 files changed, 528 insertions, 0 deletions
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'] + ... |