Fix #13202 by failing more eagerly in tcRnStmt

test cases: ghci/scripts/T13202{,a}

6 files changed, 28 insertions, 0 deletions

diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index cdf327802f..b02fdf5472 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 0000000000..5da0a3287b
--- /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 0000000000..33c1945089
--- /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 0000000000..107d332a64
--- /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 0000000000..93bc2bb3ef
--- /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 7f03cf87e2..20bc5aea56 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'])