From 50d9bc4e79b81972cf8bab1e9b7a5923e0e9b421 Mon Sep 17 00:00:00 2001
From: Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io>
Date: Fri, 22 Jul 2022 22:01:37 +0200
Subject: 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.
---
 compiler/GHC/Tc/Gen/Splice.hs    |  6 ------
 testsuite/tests/th/T21920.hs     | 13 +++++++++++++
 testsuite/tests/th/T21920.stdout |  1 +
 testsuite/tests/th/T7276.stderr  |  7 ++++++-
 testsuite/tests/th/all.T         |  1 +
 5 files changed, 21 insertions(+), 7 deletions(-)
 create mode 100644 testsuite/tests/th/T21920.hs
 create mode 100644 testsuite/tests/th/T21920.stdout

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, [''])
-- 
cgit v1.2.1