[commit: ghc] wip/rae: Fix #11811. (2750798)

[git at git.haskell.org]

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

On branch  : wip/rae
Link       : http://ghc.haskell.org/trac/ghc/changeset/275079845e9bd9465cb53cf734b880f8f5e6a0ac/ghc

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

commit 275079845e9bd9465cb53cf734b880f8f5e6a0ac
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Thu Apr 7 16:44:06 2016 +0200

    Fix #11811.
    
    Previously, I had forgotten to omit variables already in scope
    from the TypeInType CUSK check. Simple enough to fix.
    
    Test case: typecheck/should_compile/T11811


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

275079845e9bd9465cb53cf734b880f8f5e6a0ac
 compiler/rename/RnSource.hs                        |  4 +++-
 compiler/rename/RnTypes.hs                         | 13 +++++++------
 testsuite/tests/typecheck/should_compile/T11811.hs |  8 ++++++++
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 4 files changed, 19 insertions(+), 7 deletions(-)

diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 03d65ef..989f7f0 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -1410,7 +1410,9 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
 
         ; (m_sig', cusk, sig_fvs) <- case m_sig of
              Just sig -> do { fkvs <- freeKiTyVarsAllVars <$>
-                                      extractHsTyRdrTyVars sig
+                                      extractFilteredRdrTyVars sig
+                                      -- NB: filter out scoped vars, else
+                                      -- we get #11811
                             ; (sig', fvs) <- rnLHsKind doc sig
                             ; return (Just sig', null fkvs, fvs) }
              Nothing  -> return (Nothing, True, emptyFVs)
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 7a9f75d..972004a 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -25,6 +25,7 @@ module RnTypes (
         -- Binding related stuff
         bindLHsTyVarBndr,
         bindSigTyVarsFV, bindHsQTyVars, bindLRdrNames,
+        extractFilteredRdrTyVars,
         extractHsTyRdrTyVars, extractHsTysRdrTyVars,
         extractHsTysRdrTyVarsDups, rmDupsInRdrTyVars,
         extractRdrKindSigVars, extractDataDefnKindVars,
@@ -104,7 +105,7 @@ rn_hs_sig_wc_type :: Bool   -- see rnImplicitBndrs
 rn_hs_sig_wc_type no_implicit_if_forall ctxt
                   (HsIB { hsib_body = wc_ty }) thing_inside
   = do { let hs_ty = hswc_body wc_ty
-       ; free_vars <- extract_filtered_rdr_ty_vars hs_ty
+       ; free_vars <- extractFilteredRdrTyVars hs_ty
        ; (free_vars', nwc_rdrs) <- partition_nwcs free_vars
        ; rnImplicitBndrs no_implicit_if_forall free_vars' hs_ty $ \ vars ->
     do { rn_hs_wc_type ctxt wc_ty nwc_rdrs $ \ wc_ty' ->
@@ -113,7 +114,7 @@ rn_hs_sig_wc_type no_implicit_if_forall ctxt
 
 rnHsWcType :: HsDocContext -> LHsWcType RdrName -> RnM (LHsWcType Name, FreeVars)
 rnHsWcType ctxt wc_ty@(HsWC { hswc_body = hs_ty })
-  = do { free_vars <- extract_filtered_rdr_ty_vars hs_ty
+  = do { free_vars <- extractFilteredRdrTyVars hs_ty
        ; (_, nwc_rdrs) <- partition_nwcs free_vars
        ; rn_hs_wc_type ctxt wc_ty nwc_rdrs $ \ wc_ty' ->
          return (wc_ty', emptyFVs) }
@@ -197,13 +198,13 @@ rnWcSigContext env (L loc hs_ctxt)
     rn_top_constraint = rnLHsTyKi (env { rtke_what = RnTopConstraint })
 
 
--- | extract_filtered finds free type and kind variables in a type,
+-- | Finds free type and kind variables in a type,
 --     without duplicates, and
 --     without variables that are already in scope in LocalRdrEnv
 --   NB: this includes named wildcards, which look like perfectly
 --       ordinary type variables at this point
-extract_filtered_rdr_ty_vars :: LHsType RdrName -> RnM FreeKiTyVars
-extract_filtered_rdr_ty_vars hs_ty
+extractFilteredRdrTyVars :: LHsType RdrName -> RnM FreeKiTyVars
+extractFilteredRdrTyVars hs_ty
   = do { rdr_env <- getLocalRdrEnv
        ; filterInScope rdr_env <$> extractHsTyRdrTyVars hs_ty }
 
@@ -248,7 +249,7 @@ rnHsSigType :: HsDocContext -> LHsSigType RdrName
 -- Used for source-language type signatures
 -- that cannot have wildcards
 rnHsSigType ctx (HsIB { hsib_body = hs_ty })
-  = do { vars <- extract_filtered_rdr_ty_vars hs_ty
+  = do { vars <- extractFilteredRdrTyVars hs_ty
        ; rnImplicitBndrs True vars hs_ty $ \ vars ->
     do { (body', fvs) <- rnLHsType ctx hs_ty
        ; return (HsIB { hsib_vars = vars
diff --git a/testsuite/tests/typecheck/should_compile/T11811.hs b/testsuite/tests/typecheck/should_compile/T11811.hs
new file mode 100644
index 0000000..16a225b
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T11811.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeInType, GADTs #-}
+
+module T11811 where
+
+import Data.Kind
+
+data Test (a :: x) (b :: x) :: x -> *
+  where K :: Test Int Bool Double
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 0d99284..bd973f1 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -511,3 +511,4 @@ test('T11401', normal, compile, [''])
 test('T11699', normal, compile, [''])
 test('T11512', normal, compile, [''])
 test('T11754', normal, compile, [''])
+test('T11811', normal, compile, [''])