diff options
-rw-r--r-- | testsuite/tests/pmcheck/should_compile/T18371.hs | 46 | ||||
-rw-r--r-- | testsuite/tests/pmcheck/should_compile/T18371b.hs | 16 | ||||
-rw-r--r-- | testsuite/tests/pmcheck/should_compile/all.T | 4 |
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, |