[commit: ghc] ghc-8.0: Fix #11241. (314e148)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/314e1489022e3022b4b348c43a8fa6688807c0c7/ghc

>---------------------------------------------------------------

commit 314e1489022e3022b4b348c43a8fa6688807c0c7
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Wed Feb 10 08:35:22 2016 -0500

    Fix #11241.
    
    When renaming a type, now looks for wildcards in bound variables'
    kinds.
    
    testcase: dependent/should_compile/T11241
    (cherry picked from commit 43468fe386571564a4bdfc35cbaeab4199259318)


>---------------------------------------------------------------

314e1489022e3022b4b348c43a8fa6688807c0c7
 compiler/rename/RnTypes.hs                             | 9 ++++++++-
 testsuite/tests/dependent/should_compile/T11241.hs     | 6 ++++++
 testsuite/tests/dependent/should_compile/T11241.stderr | 6 ++++++
 testsuite/tests/dependent/should_compile/all.T         | 2 +-
 4 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 79f973f..3597560 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -151,7 +151,9 @@ rnWcSigTy env (L loc hs_ty@(HsForAllTy { hst_bndrs = tvs, hst_body = hs_tau }))
                       Nothing [] tvs $ \ _ tvs' ->
     do { (hs_tau', fvs) <- rnWcSigTy env hs_tau
        ; let hs_ty' = HsForAllTy { hst_bndrs = tvs', hst_body = hswc_body hs_tau' }
-       ; return ( hs_tau' { hswc_body = L loc hs_ty' }, fvs) }
+             awcs_bndrs = collectAnonWildCardsBndrs tvs'
+       ; return ( hs_tau' { hswc_wcs = hswc_wcs hs_tau' ++ awcs_bndrs
+                          , hswc_body = L loc hs_ty' }, fvs) }
 
 rnWcSigTy env (L loc (HsQualTy { hst_ctxt = hs_ctxt, hst_body = tau }))
   = do { (hs_ctxt', fvs1) <- rnWcSigContext env hs_ctxt
@@ -1047,6 +1049,11 @@ collectAnonWildCards lty = go lty
     prefix_types_only (HsAppPrefix ty) = Just ty
     prefix_types_only (HsAppInfix _)   = Nothing
 
+collectAnonWildCardsBndrs :: [LHsTyVarBndr Name] -> [Name]
+collectAnonWildCardsBndrs ltvs = concatMap (go . unLoc) ltvs
+  where
+    go (UserTyVar _)      = []
+    go (KindedTyVar _ ki) = collectAnonWildCards ki
 
 {-
 *********************************************************
diff --git a/testsuite/tests/dependent/should_compile/T11241.hs b/testsuite/tests/dependent/should_compile/T11241.hs
new file mode 100644
index 0000000..47d20d6
--- /dev/null
+++ b/testsuite/tests/dependent/should_compile/T11241.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE ExplicitForAll, KindSignatures, PartialTypeSignatures #-}
+
+module T11241 where
+
+foo :: forall (a :: _) . a -> a
+foo = id
diff --git a/testsuite/tests/dependent/should_compile/T11241.stderr b/testsuite/tests/dependent/should_compile/T11241.stderr
new file mode 100644
index 0000000..49a39a9
--- /dev/null
+++ b/testsuite/tests/dependent/should_compile/T11241.stderr
@@ -0,0 +1,6 @@
+
+T11241.hs:5:21: warning:
+    • Found type wildcard ‘_’ standing for ‘*’
+    • In the type signature:
+        foo :: forall (a :: _). a -> a
+    • Relevant bindings include foo :: a -> a (bound at T11241.hs:6:1)
diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T
index 4509072..b5e6e07 100644
--- a/testsuite/tests/dependent/should_compile/all.T
+++ b/testsuite/tests/dependent/should_compile/all.T
@@ -13,4 +13,4 @@ test('T9632', normal, compile, [''])
 test('dynamic-paper', normal, compile, [''])
 test('T11311', normal, compile, [''])
 test('T11405', normal, compile, [''])
-
+test('T11241', normal, compile, [''])