summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorRichard Eisenberg <rae@cs.brynmawr.edu>2017-07-18 19:44:17 -0400
committerRichard Eisenberg <rae@cs.brynmawr.edu>2017-07-27 07:49:06 -0400
commit1696dbf4ad0fda4d7c5b4afe1911cab51d7dd0b0 (patch)
tree8e127bcc981e23184e36c871ad7d40c80dfbc7bc /testsuite
parentca471860494484210b6291dd96d1e0868da750e7 (diff)
downloadhaskell-1696dbf4ad0fda4d7c5b4afe1911cab51d7dd0b0.tar.gz
Fix #12176 by being a bit more careful instantiating.
Previously, looking up a TyCon that said "no" to mightBeUnsaturated would then instantiate all of its invisible binders. But this is wrong for vanilla type synonyms, whose RHS kind might legitimately start with invisible binders. So a little more care is taken now, only to instantiate those invisible binders that need to be (so that the TyCon isn't unsaturated).
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/dependent/should_compile/T12176.hs18
-rw-r--r--testsuite/tests/dependent/should_compile/all.T1
2 files changed, 19 insertions, 0 deletions
diff --git a/testsuite/tests/dependent/should_compile/T12176.hs b/testsuite/tests/dependent/should_compile/T12176.hs
new file mode 100644
index 0000000000..0e340068a7
--- /dev/null
+++ b/testsuite/tests/dependent/should_compile/T12176.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE RankNTypes, TypeInType, GADTs, TypeFamilies #-}
+
+module T12176 where
+
+import Data.Kind
+
+data Proxy :: forall k. k -> Type where
+ MkProxy :: forall k (a :: k). Proxy a
+
+data X where
+ MkX :: forall (k :: Type) (a :: k). Proxy a -> X
+
+type Expr = (MkX :: forall (a :: Bool). Proxy a -> X)
+
+type family Foo (x :: forall (a :: k). Proxy a -> X) where
+ Foo (MkX :: forall (a :: k). Proxy a -> X) = (MkProxy :: Proxy k)
+
+type Bug = Foo Expr -- this failed with #12176
diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T
index 8a9b221a4e..b854f1d9e7 100644
--- a/testsuite/tests/dependent/should_compile/all.T
+++ b/testsuite/tests/dependent/should_compile/all.T
@@ -24,3 +24,4 @@ test('T11719', normal, compile, [''])
test('T11966', normal, compile, [''])
test('T12442', normal, compile, [''])
test('T13538', normal, compile, [''])
+test('T12176', normal, compile, [''])