summaryrefslogtreecommitdiff
path: root/testsuite/tests/pmcheck
diff options
context:
space:
mode:
authorSebastian Graf <sebastian.graf@kit.edu>2020-09-23 14:31:45 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-09-25 21:12:44 -0400
commit277d20af1ce54c7e2c76dfe3b96c54babceeea41 (patch)
tree444a5d26b519a1e9c8b1e30aef46fa6490b7a915 /testsuite/tests/pmcheck
parent0d6519d9e8604d067f4a4f760e4bc3403727a498 (diff)
downloadhaskell-277d20af1ce54c7e2c76dfe3b96c54babceeea41.tar.gz
Add regression tests for #18371
They have been fixed by !3959, I believe. Fixes #18371.
Diffstat (limited to 'testsuite/tests/pmcheck')
-rw-r--r--testsuite/tests/pmcheck/should_compile/T18371.hs46
-rw-r--r--testsuite/tests/pmcheck/should_compile/T18371b.hs16
-rw-r--r--testsuite/tests/pmcheck/should_compile/all.T4
3 files changed, 66 insertions, 0 deletions
diff --git a/testsuite/tests/pmcheck/should_compile/T18371.hs b/testsuite/tests/pmcheck/should_compile/T18371.hs
new file mode 100644
index 0000000000..517cb96bdd
--- /dev/null
+++ b/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 = ()
diff --git a/testsuite/tests/pmcheck/should_compile/T18371b.hs b/testsuite/tests/pmcheck/should_compile/T18371b.hs
new file mode 100644
index 0000000000..cc5aa8683e
--- /dev/null
+++ b/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 = ()
diff --git a/testsuite/tests/pmcheck/should_compile/all.T b/testsuite/tests/pmcheck/should_compile/all.T
index 862c5e134a..ba40866bcf 100644
--- a/testsuite/tests/pmcheck/should_compile/all.T
+++ b/testsuite/tests/pmcheck/should_compile/all.T
@@ -140,6 +140,10 @@ 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,