diff options
| author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2022-07-22 22:01:37 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-08-04 02:55:43 -0400 |
| commit | b99819bdaa11881f0b0bec29ef6274a8c8e565a0 (patch) | |
| tree | f6f9f324bfa90436a5b3649ed87ed6cf98fa8038 | |
| parent | 35aef18de6d04473da95cb5a19d5cc111ee7ec45 (diff) | |
| download | haskell-b99819bdaa11881f0b0bec29ef6274a8c8e565a0.tar.gz | |
Fix TH + defer-type-errors interaction (#21920)
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.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/th/T21920.hs | 13 | ||||
| -rw-r--r-- | testsuite/tests/th/T21920.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/th/T7276.stderr | 7 | ||||
| -rw-r--r-- | testsuite/tests/th/all.T | 1 |
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 650d4988d7..a475e9d5bb 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -552,3 +552,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, ['']) |