diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2020-09-23 14:41:55 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-09-25 21:12:44 -0400 |
commit | 8edf60562720b91613a6ad6b949ae08416f81c9a (patch) | |
tree | fb2ececba2a6646ab9a058394ad16abe4d2e6cc4 | |
parent | 277d20af1ce54c7e2c76dfe3b96c54babceeea41 (diff) | |
download | haskell-8edf60562720b91613a6ad6b949ae08416f81c9a.tar.gz |
Add a regression test for #18609
The egregious performance hits are gone since !4050.
So we fix #18609.
-rw-r--r-- | testsuite/tests/pmcheck/should_compile/T18609.hs | 60 | ||||
-rw-r--r-- | testsuite/tests/pmcheck/should_compile/T18609.stderr | 13 | ||||
-rw-r--r-- | testsuite/tests/pmcheck/should_compile/all.T | 2 |
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, |