Commit 8edf6056 authored by Sebastian Graf's avatar Sebastian Graf Committed by Marge Bot
Browse files

Add a regression test for #18609

The egregious performance hits are gone since !4050.
So we fix #18609.
parent 277d20af
{-# 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 = ()
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 = ...
......@@ -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,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment