[commit: ghc] ghc-8.0: Constrained types have kind * in validity check. (e7ae7cc)

[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/e7ae7cc027691000cac34a70c6efba804975c564/ghc

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

commit e7ae7cc027691000cac34a70c6efba804975c564
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Mon Jan 11 15:28:48 2016 -0500

    Constrained types have kind * in validity check.
    
    This addresses #11405, but a deeper problem lurks.
    Try test dependent/should_compile/T11405 and see comment:3
    on the ticket.
    
    (cherry picked from commit bafbde7e239dd7353fb32cb2ff1b1c9139e4f45c)


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

e7ae7cc027691000cac34a70c6efba804975c564
 compiler/typecheck/TcValidity.hs                   | 7 ++++++-
 testsuite/tests/dependent/should_compile/T11405.hs | 9 +++++++++
 testsuite/tests/dependent/should_compile/all.T     | 2 ++
 3 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs
index aec4e6d..94e749d 100644
--- a/compiler/typecheck/TcValidity.hs
+++ b/compiler/typecheck/TcValidity.hs
@@ -452,12 +452,17 @@ check_type env ctxt rank ty
                 -- but not   type T = ?x::Int
 
         ; check_type env' ctxt rank tau      -- Allow foralls to right of arrow
-        ; checkTcM (not (any (`elemVarSet` tyCoVarsOfType tau_kind) tvs))
+        ; checkTcM (not (any (`elemVarSet` tyCoVarsOfType phi_kind) tvs))
                    (forAllEscapeErr env' ty tau_kind)
         }
   where
     (tvs, theta, tau) = tcSplitSigmaTy ty
     tau_kind          = typeKind tau
+
+    phi_kind | null theta = tau_kind
+             | otherwise  = liftedTypeKind
+        -- If there are any constraints, the kind is *. (#11405)
+
     (env', _)         = tidyTyCoVarBndrs env tvs
 
 check_type _ _ _ (TyVarTy _) = return ()
diff --git a/testsuite/tests/dependent/should_compile/T11405.hs b/testsuite/tests/dependent/should_compile/T11405.hs
new file mode 100644
index 0000000..f80d994
--- /dev/null
+++ b/testsuite/tests/dependent/should_compile/T11405.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE ImplicitParams, TypeInType, ExplicitForAll #-}
+
+module T11405 where
+
+import GHC.Exts
+import GHC.Stack
+
+x :: forall (v :: Levity) (a :: TYPE v). (?callStack :: CallStack) => a
+x = undefined
diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T
index ef6dde9..c11f9ca 100644
--- a/testsuite/tests/dependent/should_compile/all.T
+++ b/testsuite/tests/dependent/should_compile/all.T
@@ -12,3 +12,5 @@ test('TypeLevelVec',normal,compile, [''])
 test('T9632', normal, compile, [''])
 test('dynamic-paper', normal, compile, [''])
 test('T11311', normal, compile, [''])
+test('T11405', expect_broken(11405), compile, [''])
+