diff options
Diffstat (limited to 'testsuite')
64 files changed, 579 insertions, 53 deletions
diff --git a/testsuite/tests/deSugar/should_compile/T2395.stderr b/testsuite/tests/deSugar/should_compile/T2395.stderr index 940f263412..a2ed232e78 100644 --- a/testsuite/tests/deSugar/should_compile/T2395.stderr +++ b/testsuite/tests/deSugar/should_compile/T2395.stderr @@ -1,4 +1,4 @@ -T2395.hs:12:1: Warning: - Pattern match(es) are overlapped +T2395.hs:12:1: warning: + Pattern match(es) are redundant In an equation for ‘bar’: bar _ = ... diff --git a/testsuite/tests/deSugar/should_compile/T5117.stderr b/testsuite/tests/deSugar/should_compile/T5117.stderr index 93de2cf9e7..954844d5f9 100644 --- a/testsuite/tests/deSugar/should_compile/T5117.stderr +++ b/testsuite/tests/deSugar/should_compile/T5117.stderr @@ -1,4 +1,4 @@ T5117.hs:15:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘f3’: f3 (MyString "a") = ... diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T index c6b024f1b9..dbc327f237 100644 --- a/testsuite/tests/deSugar/should_compile/all.T +++ b/testsuite/tests/deSugar/should_compile/all.T @@ -63,7 +63,6 @@ test('ds056', normal, compile, ['-Wall -fno-warn-tabs']) test('ds057', normal, compile, ['']) test('ds058', normal, compile, ['-W -fno-warn-tabs']) test('ds059', normal, compile, ['-W']) -test('ds060', expect_broken(322), compile, ['']) test('ds062', normal, compile, ['']) test('ds063', normal, compile, ['']) diff --git a/testsuite/tests/deSugar/should_compile/ds002.stderr b/testsuite/tests/deSugar/should_compile/ds002.stderr index fe4ec94873..3810c1b77b 100644 --- a/testsuite/tests/deSugar/should_compile/ds002.stderr +++ b/testsuite/tests/deSugar/should_compile/ds002.stderr @@ -1,10 +1,10 @@ ds002.hs:7:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘f’: f y = ... f z = ... ds002.hs:11:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘g’: g x y z = ... diff --git a/testsuite/tests/deSugar/should_compile/ds003.stderr b/testsuite/tests/deSugar/should_compile/ds003.stderr index 1b4c018b62..fdde26f10e 100644 --- a/testsuite/tests/deSugar/should_compile/ds003.stderr +++ b/testsuite/tests/deSugar/should_compile/ds003.stderr @@ -1,6 +1,6 @@ ds003.hs:5:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘f’: f (x : x1 : x2 : x3) ~(y, ys) z = ... f x y True = ... diff --git a/testsuite/tests/deSugar/should_compile/ds019.stderr b/testsuite/tests/deSugar/should_compile/ds019.stderr index 4d6e60f1fa..0a99306cd2 100644 --- a/testsuite/tests/deSugar/should_compile/ds019.stderr +++ b/testsuite/tests/deSugar/should_compile/ds019.stderr @@ -1,6 +1,6 @@ ds019.hs:5:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘f’: f d (j, k) p = ... f (e, f, g) l q = ... diff --git a/testsuite/tests/deSugar/should_compile/ds020.stderr b/testsuite/tests/deSugar/should_compile/ds020.stderr index 4120a957d3..8775bc6d6e 100644 --- a/testsuite/tests/deSugar/should_compile/ds020.stderr +++ b/testsuite/tests/deSugar/should_compile/ds020.stderr @@ -1,18 +1,18 @@ ds020.hs:8:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘a’: a ~(~[], ~[], ~[]) = ... ds020.hs:11:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘b’: b ~(~x : ~xs : ~ys) = ... ds020.hs:16:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘d’: d ~(n+43) = ... d ~(n+999) = ... ds020.hs:22:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘f’: f x@(~[]) = ... diff --git a/testsuite/tests/deSugar/should_compile/ds022.hs b/testsuite/tests/deSugar/should_compile/ds022.hs index 2ac429f95b..a857ef44b0 100644 --- a/testsuite/tests/deSugar/should_compile/ds022.hs +++ b/testsuite/tests/deSugar/should_compile/ds022.hs @@ -1,5 +1,7 @@ -- !!! ds022 -- literal patterns (wimp version) -- +{-# OPTIONS_GHC -fwarn-overlapping-patterns #-} + module ShouldCompile where f 1 1.1 = [] diff --git a/testsuite/tests/deSugar/should_compile/ds022.stderr b/testsuite/tests/deSugar/should_compile/ds022.stderr index 45fe3d8a95..17b62fee02 100644 --- a/testsuite/tests/deSugar/should_compile/ds022.stderr +++ b/testsuite/tests/deSugar/should_compile/ds022.stderr @@ -1,6 +1,6 @@ -ds022.hs:20:1: Warning: - Pattern match(es) are overlapped +ds022.hs:22:1: Warning: + Pattern match(es) are redundant In an equation for ‘i’: i 1 0.011e2 = ... i 2 2.20000 = ... diff --git a/testsuite/tests/deSugar/should_compile/ds043.stderr b/testsuite/tests/deSugar/should_compile/ds043.stderr index 8529a8c737..0339745bab 100644 --- a/testsuite/tests/deSugar/should_compile/ds043.stderr +++ b/testsuite/tests/deSugar/should_compile/ds043.stderr @@ -1,4 +1,4 @@ -ds043.hs:8:2: - Warning: Pattern match(es) are overlapped - In a case alternative: B {e = True, f = False} -> ... +ds043.hs:8:2: warning: + Pattern match(es) are redundant + In a case alternative: B {e = True, f = False} -> ... diff --git a/testsuite/tests/deSugar/should_compile/ds051.stderr b/testsuite/tests/deSugar/should_compile/ds051.stderr index 76bc4d3968..4777dfcc2d 100644 --- a/testsuite/tests/deSugar/should_compile/ds051.stderr +++ b/testsuite/tests/deSugar/should_compile/ds051.stderr @@ -1,12 +1,12 @@ ds051.hs:6:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘f1’: f1 "ab" = ... ds051.hs:11:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘f2’: f2 ('a' : 'b' : []) = ... ds051.hs:16:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘f3’: f3 "ab" = ... diff --git a/testsuite/tests/deSugar/should_compile/ds056.stderr b/testsuite/tests/deSugar/should_compile/ds056.stderr index 3f44267f2a..bcea3fdb07 100644 --- a/testsuite/tests/deSugar/should_compile/ds056.stderr +++ b/testsuite/tests/deSugar/should_compile/ds056.stderr @@ -1,4 +1,4 @@ -ds056.hs:8:1: Warning: - Pattern match(es) are overlapped +ds056.hs:8:1: warning: + Pattern match(es) are redundant In an equation for ‘g’: g _ = ... diff --git a/testsuite/tests/deSugar/should_compile/ds058.stderr b/testsuite/tests/deSugar/should_compile/ds058.stderr index fb504cc514..82f8141280 100644 --- a/testsuite/tests/deSugar/should_compile/ds058.stderr +++ b/testsuite/tests/deSugar/should_compile/ds058.stderr @@ -1,4 +1,4 @@ -ds058.hs:5:7: - Warning: Pattern match(es) are overlapped - In a case alternative: Just _ -> ... +ds058.hs:5:7: warning: + Pattern match(es) are redundant + In a case alternative: Just _ -> ... diff --git a/testsuite/tests/deSugar/should_compile/ds060.hs b/testsuite/tests/deSugar/should_compile/ds060.hs deleted file mode 100644 index b822605742..0000000000 --- a/testsuite/tests/deSugar/should_compile/ds060.hs +++ /dev/null @@ -1,25 +0,0 @@ - --- Test for trac #322 - -module ShouldCompile 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 -- Gives bogus "Warning: Pattern match(es) are overlapped" -f _ = 3 - diff --git a/testsuite/tests/driver/werror.stderr b/testsuite/tests/driver/werror.stderr index 5541dfc2e7..20770fa8bc 100644 --- a/testsuite/tests/driver/werror.stderr +++ b/testsuite/tests/driver/werror.stderr @@ -19,12 +19,12 @@ werror.hs:10:1: Warning: f :: forall t t1. [t] -> [t1] werror.hs:10:1: Warning: - Pattern match(es) are overlapped + Pattern match(es) are redundant In an equation for ‘f’: f [] = ... werror.hs:10:1: Warning: Pattern match(es) are non-exhaustive - In an equation for ‘f’: Patterns not matched: _ : _ + In an equation for ‘f’: Patterns not matched: (_:_) <no location info>: Failing due to -Werror. diff --git a/testsuite/tests/gadt/Gadt17_help.hs b/testsuite/tests/gadt/Gadt17_help.hs index e3b8e3a918..5161fdcdb7 100644 --- a/testsuite/tests/gadt/Gadt17_help.hs +++ b/testsuite/tests/gadt/Gadt17_help.hs @@ -16,7 +16,6 @@ instance (Eq a) => Eq (TypeWitness a) where (==) TWBool TWBool = True (==) TWFloat TWFloat = True (==) TWDouble TWDouble = True - (==) _ _ = False data TernOp a b c d where OpIf :: TypeWitness a -> TernOp Bool a a a diff --git a/testsuite/tests/gadt/T7294.stderr b/testsuite/tests/gadt/T7294.stderr index b4379b10bb..0fa7f5386c 100644 --- a/testsuite/tests/gadt/T7294.stderr +++ b/testsuite/tests/gadt/T7294.stderr @@ -1,4 +1,8 @@ +T7294.hs:23:1: warning:
+ Pattern match(es) are redundant
+ In an equation for ‘nth’: nth Nil _ = ...
+
T7294.hs:25:5: Warning:
Couldn't match type ‘'True’ with ‘'False’
Inaccessible code in
diff --git a/testsuite/tests/ghci/scripts/Defer02.stderr b/testsuite/tests/ghci/scripts/Defer02.stderr index 83e9f7d157..8b63df689a 100644 --- a/testsuite/tests/ghci/scripts/Defer02.stderr +++ b/testsuite/tests/ghci/scripts/Defer02.stderr @@ -12,6 +12,10 @@ • In the expression: 'p' In an equation for ‘a’: a = 'p' +../../typecheck/should_run/Defer01.hs:25:1: warning: + Pattern match(es) have inaccessible right hand side + In an equation for ‘c’: c (C2 x) = ... + ../../typecheck/should_run/Defer01.hs:25:4: warning: • Couldn't match type ‘Int’ with ‘Bool’ Inaccessible code in @@ -91,6 +95,10 @@ In the type signature: k :: (Int ~ Bool) => Int -> Bool +../../typecheck/should_run/Defer01.hs:46:1: warning: + Pattern match(es) are redundant + In an equation for ‘k’: k x = ... + ../../typecheck/should_run/Defer01.hs:49:5: warning: • Couldn't match expected type ‘IO a0’ with actual type ‘Char -> IO ()’ 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'] + ... diff --git a/testsuite/tests/typecheck/should_compile/T5490.stderr b/testsuite/tests/typecheck/should_compile/T5490.stderr new file mode 100644 index 0000000000..7a32e9d7ad --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T5490.stderr @@ -0,0 +1,8 @@ + +T5490.hs:245:15: warning: + Pattern match(es) are redundant + In a case alternative: HDropZero -> ... + +T5490.hs:288:3: warning: + Pattern match(es) are redundant + In a case alternative: _ -> ... |