[commit: ghc] master: Fix #13202 by failing more eagerly in tcRnStmt (fa13c13)

[git at git.haskell.org]

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

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

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

commit fa13c136e6e666b9a1393c1c0041020ad842c069
Author: Richard Eisenberg <rae at cs.brynmawr.edu>
Date:   Thu Mar 16 11:38:05 2017 -0400

    Fix #13202 by failing more eagerly in tcRnStmt
    
    test cases: ghci/scripts/T13202{,a}


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

fa13c136e6e666b9a1393c1c0041020ad842c069
 compiler/typecheck/TcRnDriver.hs            | 3 +++
 testsuite/tests/ghci/scripts/T13202.script  | 6 ++++++
 testsuite/tests/ghci/scripts/T13202.stderr  | 8 ++++++++
 testsuite/tests/ghci/scripts/T13202a.script | 3 +++
 testsuite/tests/ghci/scripts/T13202a.stderr | 6 ++++++
 testsuite/tests/ghci/scripts/all.T          | 2 ++
 6 files changed, 28 insertions(+)

diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index cdf3278..b02fdf5 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -1877,6 +1877,9 @@ tcRnStmt hsc_env rdr_stmt
     zonked_expr <- zonkTopLExpr tc_expr ;
     zonked_ids  <- zonkTopBndrs bound_ids ;
 
+    failIfErrsM ;  -- we can't do the next step if there are levity polymorphism errors
+                   -- test case: ghci/scripts/T13202{,a}
+
         -- None of the Ids should be of unboxed type, because we
         -- cast them all to HValues in the end!
     mapM_ bad_unboxed (filter (isUnliftedType . idType) zonked_ids) ;
diff --git a/testsuite/tests/ghci/scripts/T13202.script b/testsuite/tests/ghci/scripts/T13202.script
new file mode 100644
index 0000000..5da0a32
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13202.script
@@ -0,0 +1,6 @@
+import GHC.Exts
+:set -XTypeApplications -XMagicHash -XTypeInType
+data TypeRep (a :: k) = TypeRep
+let typeRepKind = undefined :: TypeRep (a :: k) -> TypeRep k
+let typeRep = undefined :: TypeRep (a :: k)
+let x = typeRepKind (typeRep @(Maybe Int#))
diff --git a/testsuite/tests/ghci/scripts/T13202.stderr b/testsuite/tests/ghci/scripts/T13202.stderr
new file mode 100644
index 0000000..33c1945
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13202.stderr
@@ -0,0 +1,8 @@
+
+<interactive>:6:22: error:
+    • Cannot apply expression of type ‘TypeRep a0’
+      to a visible type argument ‘(Maybe Int#)’
+    • In the first argument of ‘typeRepKind’, namely
+        ‘(typeRep @(Maybe Int#))’
+      In the expression: typeRepKind (typeRep @(Maybe Int#))
+      In an equation for ‘x’: x = typeRepKind (typeRep @(Maybe Int#))
diff --git a/testsuite/tests/ghci/scripts/T13202a.script b/testsuite/tests/ghci/scripts/T13202a.script
new file mode 100644
index 0000000..107d332
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13202a.script
@@ -0,0 +1,3 @@
+import GHC.Records
+:set -XTypeApplications -XDataKinds
+let foo = getField @"name"
diff --git a/testsuite/tests/ghci/scripts/T13202a.stderr b/testsuite/tests/ghci/scripts/T13202a.stderr
new file mode 100644
index 0000000..93bc2bb
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13202a.stderr
@@ -0,0 +1,6 @@
+
+<interactive>:3:5: error:
+    • Non type-variable argument in the constraint: HasField "name" r a
+      (Use FlexibleContexts to permit this)
+    • When checking the inferred type
+        foo :: forall r a. HasField "name" r a => r -> a
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 7f03cf8..20bc5ae 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -248,3 +248,5 @@ test('T12447', expect_broken(12447), ghci_script, ['T12447.script'])
 test('T10249', normal, ghci_script, ['T10249.script'])
 test('T12550', normal, ghci_script, ['T12550.script'])
 test('StaticPtr', normal, ghci_script, ['StaticPtr.script'])
+test('T13202', normal, ghci_script, ['T13202.script'])
+test('T13202a', normal, ghci_script, ['T13202a.script'])