summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-04-08 11:44:09 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-04-12 13:51:23 -0400
commit18cbff86ec0cd3d06e99e3a00753cd66153210b5 (patch)
treefa4e1780edcf158de1a711776e6fc98d3eb74cf9
parent792d9289434cb7418a559cd4157ee3bfaef54c99 (diff)
downloadhaskell-18cbff86ec0cd3d06e99e3a00753cd66153210b5.tar.gz
template-haskell: Run TH splices with err_vars from current context
Otherwise, errors can go missing which arise when running the splices. Fixes #19470
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs6
-rw-r--r--testsuite/tests/th/T19470.script2
-rw-r--r--testsuite/tests/th/T19470.stderr13
-rw-r--r--testsuite/tests/th/all.T1
4 files changed, 21 insertions, 1 deletions
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 4fadae964b..589513af97 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -674,7 +674,11 @@ tcTopSplice expr res_ty
-- See Note [Running typed splices in the zonker]
runTopSplice :: DelayedSplice -> TcM (HsExpr GhcTc)
runTopSplice (DelayedSplice lcl_env orig_expr res_ty q_expr)
- = setLclEnv lcl_env $ do {
+ = do
+ errs_var <- getErrsVar
+ setLclEnv lcl_env $ setErrsVar errs_var $ do {
+ -- Set the errs_var to the errs_var from the current context,
+ -- otherwise error messages can go missing in GHCi (#19470)
zonked_ty <- zonkTcType res_ty
; zonked_q_expr <- zonkTopLExpr q_expr
-- See Note [Collecting modFinalizers in typed splices].
diff --git a/testsuite/tests/th/T19470.script b/testsuite/tests/th/T19470.script
new file mode 100644
index 0000000000..1fb0b3457d
--- /dev/null
+++ b/testsuite/tests/th/T19470.script
@@ -0,0 +1,2 @@
+:set -XTemplateHaskell
+print ($$undefined :: String)
diff --git a/testsuite/tests/th/T19470.stderr b/testsuite/tests/th/T19470.stderr
new file mode 100644
index 0000000000..aaf251d086
--- /dev/null
+++ b/testsuite/tests/th/T19470.stderr
@@ -0,0 +1,13 @@
+
+<interactive>:2:10: error:
+ • Exception when trying to run compile-time code:
+ Prelude.undefined
+CallStack (from HasCallStack):
+ error, called at libraries/base/GHC/Err.hs:74:14 in base:GHC.Err
+ undefined, called at <interactive>:2:10 in interactive:Ghci1
+ Code: undefined
+ • In the Template Haskell splice $$undefined
+ In the first argument of ‘print’, namely ‘($$undefined :: String)’
+ In the first argument of ‘GHC.GHCi.ghciStepIO ::
+ IO a -> IO a’, namely
+ ‘(print ($$undefined :: String))’
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index fbc8428503..564649b373 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -521,3 +521,4 @@ test('T18740d', normal, compile_fail, [''])
test('T19363', normal, compile_and_run, [''])
test('T19377', normal, compile, [''])
test('T17804', normal, compile, [''])
+test('T19470', only_ways(['ghci']), ghci_script, ['T19470.script'])