[Git][ghc/ghc][wip/T18371] Add a regression test for #18609

[Sebastian Graf]

Sebastian Graf pushed to branch wip/T18371 at Glasgow Haskell Compiler / GHC


Commits:
d568ec58 by Sebastian Graf at 2020-09-23T14:41:55+02:00
Add a regression test for #18609

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

- - - - -


3 changed files:

- + testsuite/tests/pmcheck/should_compile/T18609.hs
- + testsuite/tests/pmcheck/should_compile/T18609.stderr
- testsuite/tests/pmcheck/should_compile/all.T


Changes:

=====================================
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 = ()


=====================================
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 = ...


=====================================
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'])
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d568ec5857a649953992006d5b8f3be58e15ba19

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d568ec5857a649953992006d5b8f3be58e15ba19
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200923/e433bf66/attachment-0001.html>