[commit: ghc] ghc-8.2: Fix #11963 by checking for more mixed type/kinds (18dee89)

[git at git.haskell.org]

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

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/18dee8912f6afdcf13073d3d95d85513c14180e3/ghc

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

commit 18dee8912f6afdcf13073d3d95d85513c14180e3
Author: Richard Eisenberg <rae at cs.brynmawr.edu>
Date:   Tue Jul 18 15:49:38 2017 -0400

    Fix #11963 by checking for more mixed type/kinds
    
    This is a straightforward fix -- there were just some omitted
    checks.
    
    test case: typecheck/should_fail/T11963
    
    (cherry picked from commit 10d13b62c7ba8c44000a0d25afd66788de8040c4)


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

18dee8912f6afdcf13073d3d95d85513c14180e3
 compiler/rename/RnTypes.hs                         | 25 +++++++++++++++----
 testsuite/tests/typecheck/should_fail/T11963.hs    | 29 ++++++++++++++++++++++
 .../tests/typecheck/should_fail/T11963.stderr      | 20 +++++++++++++++
 testsuite/tests/typecheck/should_fail/all.T        |  1 +
 4 files changed, 70 insertions(+), 5 deletions(-)

diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 0bf48ee..f829c4f 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -1706,11 +1706,25 @@ extract_hs_tv_bndrs tvs
   = do { FKTV bndr_kvs _
            <- foldrM extract_lkind emptyFKTV [k | L _ (KindedTyVar _ k) <- tvs]
 
-       ; let locals = map hsLTyVarName tvs
+       ; let locals = map hsLTyVarLocName tvs
+
+         -- These checks are all tested in typecheck/should_fail/T11963
+       ; check_for_mixed_vars bndr_kvs acc_tvs
+       ; check_for_mixed_vars bndr_kvs body_tvs
+       ; check_for_mixed_vars body_tvs acc_kvs
+       ; check_for_mixed_vars body_kvs acc_tvs
+       ; check_for_mixed_vars locals body_kvs
+
        ; return $
-         FKTV (filterOut ((`elem` locals) . unLoc) (bndr_kvs ++ body_kvs)
+         FKTV (filterOut (`elemRdr` locals) (bndr_kvs ++ body_kvs)
                 ++ acc_kvs)
-              (filterOut ((`elem` locals) . unLoc)  body_tvs ++ acc_tvs) }
+              (filterOut (`elemRdr` locals) body_tvs ++ acc_tvs) }
+  where
+    check_for_mixed_vars :: [Located RdrName] -> [Located RdrName] -> RnM ()
+    check_for_mixed_vars tvs1 tvs2 = mapM_ check tvs1
+      where
+        check tv1 = when (isRdrTyVar (unLoc tv1) && (tv1 `elemRdr` tvs2)) $
+                    mixedVarsErr tv1
 
 extract_tv :: TypeOrKind -> Located RdrName -> FreeKiTyVars -> RnM FreeKiTyVars
 extract_tv t_or_k ltv@(L _ tv) acc
@@ -1725,8 +1739,6 @@ extract_tv t_or_k ltv@(L _ tv) acc
                 mixedVarsErr ltv
               ; return (FKTV (ltv : kvs) tvs) }
   | otherwise     = return acc
-  where
-    elemRdr x = any (eqLocated x)
 
 mixedVarsErr :: Located RdrName -> RnM ()
 mixedVarsErr (L loc tv)
@@ -1739,3 +1751,6 @@ mixedVarsErr (L loc tv)
 -- just used in this module; seemed convenient here
 nubL :: Eq a => [Located a] -> [Located a]
 nubL = nubBy eqLocated
+
+elemRdr :: Located RdrName -> [Located RdrName] -> Bool
+elemRdr x = any (eqLocated x)
diff --git a/testsuite/tests/typecheck/should_fail/T11963.hs b/testsuite/tests/typecheck/should_fail/T11963.hs
new file mode 100644
index 0000000..c4f78ae
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T11963.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE GADTs, PolyKinds, RankNTypes #-}
+
+module T11963 where
+
+-- this module should be rejected without TypeInType
+
+import Data.Proxy
+
+-- see code in RnTypes.extract_hs_tv_bndrs which checks for these bad cases
+
+  -- bndr_kvs vs body_tvs
+data Typ k t  where
+    Typ :: (forall (a :: k -> *). a t -> a t) -> Typ k t
+
+  -- bndr_kvs vs acc_tvs
+foo :: (forall (t :: k). Proxy t) -> Proxy k
+foo _ = undefined
+
+  -- locals vs body_kvs
+bar :: forall k. forall (t :: k). Proxy t
+bar = undefined
+
+  -- body_kvs vs acc_tvs
+quux :: (forall t. Proxy (t :: k)) -> Proxy k
+quux _ = undefined
+
+  -- body_tvs vs acc_kvs
+blargh :: (forall a. a -> Proxy k) -> Proxy (t :: k)
+blargh _ = undefined
diff --git a/testsuite/tests/typecheck/should_fail/T11963.stderr b/testsuite/tests/typecheck/should_fail/T11963.stderr
new file mode 100644
index 0000000..74c3ab0
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T11963.stderr
@@ -0,0 +1,20 @@
+
+T11963.hs:13:26: error:
+    Variable ‘k’ used as both a kind and a type
+    Did you intend to use TypeInType?
+
+T11963.hs:16:22: error:
+    Variable ‘k’ used as both a kind and a type
+    Did you intend to use TypeInType?
+
+T11963.hs:20:15: error:
+    Variable ‘k’ used as both a kind and a type
+    Did you intend to use TypeInType?
+
+T11963.hs:24:32: error:
+    Variable ‘k’ used as both a kind and a type
+    Did you intend to use TypeInType?
+
+T11963.hs:28:33: error:
+    Variable ‘k’ used as both a kind and a type
+    Did you intend to use TypeInType?
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 6519122..c5a986d 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -434,3 +434,4 @@ test('T12709', normal, compile_fail, [''])
 test('T13446', normal, compile_fail, [''])
 test('T13320', normal, compile_fail, [''])
 test('T13677', normal, compile_fail, [''])
+test('T11963', normal, compile_fail, [''])