[Git][ghc/ghc][wip/T18371] 3 commits: Add regression tests for #18371
Sebastian Graf
gitlab at gitlab.haskell.org
Thu Sep 24 09:31:14 UTC 2020
Sebastian Graf pushed to branch wip/T18371 at Glasgow Haskell Compiler / GHC
Commits:
00190df0 by Sebastian Graf at 2020-09-24T11:31:06+02:00
Add regression tests for #18371
They have been fixed by !3959, I believe.
Fixes #18371.
- - - - -
b008d972 by Sebastian Graf at 2020-09-24T11:31:06+02:00
Add a regression test for #18609
The egregious performance hits are gone since !4050.
So we fix #18609.
- - - - -
b6bd12cf by Sebastian Graf at 2020-09-24T11:31:06+02:00
Accept new test output for #17218
The expected test output was plain wrong.
It has been fixed for a long time.
Thus we can close #17218.
- - - - -
6 changed files:
- testsuite/tests/pmcheck/should_compile/T17218.stderr
- + testsuite/tests/pmcheck/should_compile/T18371.hs
- + testsuite/tests/pmcheck/should_compile/T18371b.hs
- + 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/T17218.stderr
=====================================
@@ -1,6 +1,4 @@
T17218.hs:11:1: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
- In an equation for ‘f’:
- Patterns not matched:
- C
+ In an equation for ‘f’: Patterns not matched: P
=====================================
testsuite/tests/pmcheck/should_compile/T18371.hs
=====================================
@@ -0,0 +1,46 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# OPTIONS_GHC -Wincomplete-patterns #-}
+module Bug where
+
+import Data.Kind
+import Unsafe.Coerce
+
+type family Sing :: k -> Type
+
+class SingI a where
+ sing :: Sing a
+
+data SingInstance :: forall k. k -> Type where
+ SingInstance :: SingI a => SingInstance a
+
+newtype DI (a :: k) = Don'tInstantiate (SingI a => SingInstance a)
+
+singInstance :: forall k (a :: k). Sing a -> SingInstance a
+singInstance s = with_sing_i SingInstance
+ where
+ with_sing_i :: (SingI a => SingInstance a) -> SingInstance a
+ with_sing_i si = unsafeCoerce (Don'tInstantiate si) s
+
+{-# COMPLETE Sing #-}
+pattern Sing :: forall k (a :: k). () => SingI a => Sing a
+pattern Sing <- (singInstance -> SingInstance)
+ where Sing = sing
+
+-----
+
+data SBool :: Bool -> Type where
+ SFalse :: SBool False
+ STrue :: SBool True
+type instance Sing = SBool
+
+f :: SBool b -> ()
+f Sing = ()
+
+g :: Sing (b :: Bool) -> ()
+g Sing = ()
=====================================
testsuite/tests/pmcheck/should_compile/T18371b.hs
=====================================
@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TypeFamilies #-}
+module Lib where
+
+type family T
+
+pattern P :: T
+pattern P <- _
+{-# COMPLETE P #-}
+
+data U = U
+type instance T = U
+
+f :: U -> ()
+f P = ()
=====================================
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
=====================================
@@ -96,7 +96,7 @@ test('T17215', expect_broken(17215), compile,
['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
test('T17216', expect_broken(17216), compile,
['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
-test('T17218', expect_broken(17218), compile,
+test('T17218', normal, compile,
['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
test('T17219', expect_broken(17219), compile,
['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
@@ -140,12 +140,18 @@ test('T18273', normal, compile,
['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
test('T18341', normal, compile,
['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T18371', normal, compile,
+ ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T18371b', normal, compile,
+ ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
test('T18478', collect_compiler_stats('bytes allocated',10), compile,
['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
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/-/compare/5ab474b3fada3030bee7fc77026b90e234826658...b6bd12cf75dbe0d8ff698d6d8678fc6848643c1f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ab474b3fada3030bee7fc77026b90e234826658...b6bd12cf75dbe0d8ff698d6d8678fc6848643c1f
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/20200924/3923e86a/attachment-0001.html>
More information about the ghc-commits
mailing list