summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2022-07-22 22:01:37 +0200
committerKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2022-07-25 22:08:30 +0200
commit50d9bc4e79b81972cf8bab1e9b7a5923e0e9b421 (patch)
treeb1890de087d97e15b4bcd30a5eebc9b9bc7faec8
parent460505345e500eb902da9737c75c077d5fc5ef66 (diff)
downloadhaskell-wip/T21920.tar.gz
Fix TH + defer-type-errors interaction (#21920)wip/T21920
Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred.
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs6
-rw-r--r--testsuite/tests/th/T21920.hs13
-rw-r--r--testsuite/tests/th/T21920.stdout1
-rw-r--r--testsuite/tests/th/T7276.stderr7
-rw-r--r--testsuite/tests/th/all.T1
5 files changed, 21 insertions, 7 deletions
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 4c6279a6d9..52205cd944 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -877,12 +877,6 @@ tcTopSpliceExpr :: SpliceType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
tcTopSpliceExpr isTypedSplice tc_action
= checkNoErrs $ -- checkNoErrs: must not try to run the thing
-- if the type checker fails!
- unsetGOptM Opt_DeferTypeErrors $
- -- Don't defer type errors. Not only are we
- -- going to run this code, but we do an unsafe
- -- coerce, so we get a seg-fault if, say we
- -- splice a type into a place where an expression
- -- is expected (#7276)
setStage (Splice isTypedSplice) $
do { -- Typecheck the expression
(mb_expr', wanted) <- tryCaptureConstraints tc_action
diff --git a/testsuite/tests/th/T21920.hs b/testsuite/tests/th/T21920.hs
new file mode 100644
index 0000000000..10d08e92bd
--- /dev/null
+++ b/testsuite/tests/th/T21920.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fdefer-type-errors #-}
+module Main where
+
+import Language.Haskell.TH.Syntax
+
+p :: Bool
+p = $(const [| True |] ('a' + 'a'))
+
+q :: Bool
+q = $$(const [|| True ||] ('a' + 'a'))
+
+main = print (p, q)
diff --git a/testsuite/tests/th/T21920.stdout b/testsuite/tests/th/T21920.stdout
new file mode 100644
index 0000000000..1fa0b54b36
--- /dev/null
+++ b/testsuite/tests/th/T21920.stdout
@@ -0,0 +1 @@
+(True,True)
diff --git a/testsuite/tests/th/T7276.stderr b/testsuite/tests/th/T7276.stderr
index 9ab73ad4cd..2b1dfb96be 100644
--- a/testsuite/tests/th/T7276.stderr
+++ b/testsuite/tests/th/T7276.stderr
@@ -1,5 +1,7 @@
-T7276.hs:6:8: error:
+T7276.hs:6:5: error:
+ • Exception when trying to run compile-time code:
+ T7276.hs:6:8: error:
• Couldn't match type ‘[Language.Haskell.TH.Syntax.Dec]’
with ‘Language.Haskell.TH.Syntax.Exp’
Expected: Language.Haskell.TH.Lib.Internal.ExpQ
@@ -7,3 +9,6 @@ T7276.hs:6:8: error:
Language.Haskell.TH.Lib.Internal.Decs
• In the expression: [d| y = 3 |]
In the untyped splice: $([d| y = 3 |])
+(deferred type error)
+ Code: ([d| y = 3 |])
+ • In the untyped splice: $([d| y = 3 |])
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 9b606a70e4..95e608e3e1 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -554,3 +554,4 @@ test('T15433b', [extra_files(['T15433_aux.hs'])], multimod_compile, ['T15433b',
test('T20711', normal, compile_and_run, [''])
test('T20868', normal, compile_and_run, [''])
test('Lift_ByteArray', normal, compile_and_run, [''])
+test('T21920', normal, compile_and_run, [''])