summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2016-11-24 12:15:34 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2016-11-25 17:46:50 +0000
commit83a952d14012ff4706a366a3155712f8caa69ead (patch)
treecf1f93a95773388ef77d38d837fb19fd7f259d6d
parentf0f468262d8b3932de0ce79f4fd98fecf51a62a3 (diff)
downloadhaskell-83a952d14012ff4706a366a3155712f8caa69ead.tar.gz
Test Trac #12845
-rw-r--r--testsuite/tests/partial-sigs/should_compile/T12845.hs23
-rw-r--r--testsuite/tests/partial-sigs/should_compile/T12845.stderr7
-rw-r--r--testsuite/tests/partial-sigs/should_compile/all.T1
3 files changed, 31 insertions, 0 deletions
diff --git a/testsuite/tests/partial-sigs/should_compile/T12845.hs b/testsuite/tests/partial-sigs/should_compile/T12845.hs
new file mode 100644
index 0000000000..d9b8a99657
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/T12845.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+
+module T12845 where
+
+import Data.Proxy
+
+data Foo (m :: Bool)
+
+type family Head (xs :: [(Bool, Bool)]) where Head (x ': xs) = x
+
+type family Bar (x :: Bool) (y :: Bool) :: Bool
+
+-- to trigger the bug, r and r' cannot *both* appear on the RHS
+broken :: forall r r' rngs . ('(r,r') ~ Head rngs, Bar r r' ~ 'True, _)
+ => Foo r -> Proxy rngs -> ()
+broken x _ = let y = requireBar x :: Foo r' in ()
+
+requireBar :: (Bar m m' ~ 'True) => Foo m -> Foo m'
+requireBar = undefined
diff --git a/testsuite/tests/partial-sigs/should_compile/T12845.stderr b/testsuite/tests/partial-sigs/should_compile/T12845.stderr
new file mode 100644
index 0000000000..0d19b1a6ed
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/T12845.stderr
@@ -0,0 +1,7 @@
+
+T12845.hs:18:70: warning: [-Wpartial-type-signatures (in -Wdefault)]
+ • Found type wildcard ‘_’ standing for ‘() :: Constraint’
+ • In the type signature:
+ broken :: forall r r' rngs.
+ ('(r, r') ~ Head rngs, Bar r r' ~ True, _) =>
+ Foo r -> Proxy rngs -> ()
diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T
index d2c68366ff..b3208518f4 100644
--- a/testsuite/tests/partial-sigs/should_compile/all.T
+++ b/testsuite/tests/partial-sigs/should_compile/all.T
@@ -67,3 +67,4 @@ test('T11339a', normal, compile, [''])
test('T11670', normal, compile, [''])
test('T12156', normal, compile_fail, ['-fdefer-typed-holes'])
test('T12531', normal, compile, ['-fdefer-typed-holes'])
+test('T12845', normal, compile, [''])