[commit: ghc] master: Fix `:k` command: add validity checking (c4a876d)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c4a876d5f99554e87400946dd26ca11819d11673/ghc

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

commit c4a876d5f99554e87400946dd26ca11819d11673
Author: Ningning Xie <xnningxie at gmail.com>
Date:   Sun Oct 28 12:26:12 2018 -0400

    Fix `:k` command: add validity checking
    
    Summary:
    This patch fixes #15806, where we found that the `:k` command in GHCi
    misses a validity checking for the type.
    
    Missing validity checking causes `:k` to accept types that are not validated.
    For example, `:k (Maybe (forall a. a -> a))` (incorrectly) returns `*`, while
    impredictivity of type instantiation shouldn't be allowed.
    
    Test Plan: ./validate
    
    Reviewers: simonpj, goldfire, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, carter
    
    GHC Trac Issues: #15806
    
    Differential Revision: https://phabricator.haskell.org/D5265


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

c4a876d5f99554e87400946dd26ca11819d11673
 compiler/typecheck/TcHsType.hs                | 2 +-
 compiler/typecheck/TcRnDriver.hs              | 4 ++++
 testsuite/tests/ghci/should_run/T15806.script | 3 +++
 testsuite/tests/ghci/should_run/T15806.stderr | 3 +++
 testsuite/tests/ghci/should_run/T15806.stdout | 1 +
 testsuite/tests/ghci/should_run/all.T         | 1 +
 6 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 24299dd..2194fa0 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -174,7 +174,7 @@ pprSigCtxt ctxt hs_ty
 
 tcHsSigWcType :: UserTypeCtxt -> LHsSigWcType GhcRn -> TcM Type
 -- This one is used when we have a LHsSigWcType, but in
--- a place where wildards aren't allowed. The renamer has
+-- a place where wildcards aren't allowed. The renamer has
 -- already checked this, so we can simply ignore it.
 tcHsSigWcType ctxt sig_ty = tcHsSigType ctxt (dropWildCards sig_ty)
 
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 814a580..1c04327 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -51,6 +51,7 @@ import {-# SOURCE #-} TcSplice ( finishTH, runRemoteModFinalizers )
 import RnSplice ( rnTopSpliceDecls, traceSplice, SpliceInfo(..) )
 import IfaceEnv( externaliseName )
 import TcHsType
+import TcValidity( checkValidType )
 import TcMatches
 import Inst( deeplyInstantiate )
 import TcUnify( checkConstraints )
@@ -2397,6 +2398,9 @@ tcRnType hsc_env normalise rdr_type
        ; kvs <- kindGeneralize kind
        ; ty  <- zonkTcTypeToType ty
 
+       -- Do validity checking on type
+       ; checkValidType GhciCtxt ty
+
        ; ty' <- if normalise
                 then do { fam_envs <- tcGetFamInstEnvs
                         ; let (_, ty')
diff --git a/testsuite/tests/ghci/should_run/T15806.script b/testsuite/tests/ghci/should_run/T15806.script
new file mode 100644
index 0000000..71f0dee
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T15806.script
@@ -0,0 +1,3 @@
+:set -XRankNTypes
+:k (Maybe Int)
+:k (Maybe (forall a. a -> a))
\ No newline at end of file
diff --git a/testsuite/tests/ghci/should_run/T15806.stderr b/testsuite/tests/ghci/should_run/T15806.stderr
new file mode 100644
index 0000000..b7e0b4b
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T15806.stderr
@@ -0,0 +1,3 @@
+<interactive>:1:1: error:
+    Illegal polymorphic type: forall a. a -> a
+    GHC doesn't yet support impredicative polymorphism
\ No newline at end of file
diff --git a/testsuite/tests/ghci/should_run/T15806.stdout b/testsuite/tests/ghci/should_run/T15806.stdout
new file mode 100644
index 0000000..f4e9f23
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T15806.stdout
@@ -0,0 +1 @@
+(Maybe Int) :: *
\ No newline at end of file
diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T
index 70e200c..855b603 100644
--- a/testsuite/tests/ghci/should_run/all.T
+++ b/testsuite/tests/ghci/should_run/all.T
@@ -35,3 +35,4 @@ test('T14963a', just_ghci, ghci_script, ['T14963a.script'])
 test('T14963b', just_ghci, ghci_script, ['T14963b.script'])
 test('T14963c', [extra_hc_opts("-fdefer-type-errors")], ghci_script, ['T14963c.script'])
 test('T15007', just_ghci, ghci_script, ['T15007.script'])
+test('T15806',     just_ghci, ghci_script, ['T15806.script'])