summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2021-07-30 09:38:54 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2021-07-30 12:05:11 +0100
commiteff51e2aca978ebd0ca08345fb1790d70f6bb7c8 (patch)
tree7cdb7fc0fc0b27bacb502d4fee336e9fe0e23fa1
parent54d6b20192fe6fc244248c7766533a768c591bae (diff)
downloadhaskell-wip/T20179.tar.gz
Catch type-checker exceptions when splicingwip/T20179
In GHC.Tc.Gen.Splice.tcTopSpliceExpr we were forgetting to catch exceptions. As a result we missed the kind error in the unsolved constraints. This patch has an easy fix, which cures #20179
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs14
-rw-r--r--testsuite/tests/th/T20179.hs7
-rw-r--r--testsuite/tests/th/T20179.stderr10
-rw-r--r--testsuite/tests/th/all.T1
4 files changed, 28 insertions, 4 deletions
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index fcd1474afa..13cd3e71c9 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -754,11 +754,17 @@ tcTopSpliceExpr isTypedSplice tc_action
-- is expected (#7276)
setStage (Splice isTypedSplice) $
do { -- Typecheck the expression
- (expr', wanted) <- captureConstraints tc_action
- ; const_binds <- simplifyTop wanted
+ (mb_expr', wanted) <- tryCaptureConstraints tc_action
+ -- If tc_action fails (perhaps because of insoluble constraints)
+ -- we want to capture and report those constraints, else we may
+ -- just get a silent failure (#20179). Hence the 'try' part.
- -- Zonk it and tie the knot of dictionary bindings
- ; return $ mkHsDictLet (EvBinds const_binds) expr' }
+ ; const_binds <- simplifyTop wanted
+
+ ; case mb_expr' of
+ Nothing -> failM -- In this case simplifyTop should have
+ -- reported some errors
+ Just expr' -> return $ mkHsDictLet (EvBinds const_binds) expr' }
{-
************************************************************************
diff --git a/testsuite/tests/th/T20179.hs b/testsuite/tests/th/T20179.hs
new file mode 100644
index 0000000000..a01f573979
--- /dev/null
+++ b/testsuite/tests/th/T20179.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Bug where
+
+$(let slurmp :: [Maybe]
+ slurmp = []
+
+ in pure [])
diff --git a/testsuite/tests/th/T20179.stderr b/testsuite/tests/th/T20179.stderr
new file mode 100644
index 0000000000..28eb54d698
--- /dev/null
+++ b/testsuite/tests/th/T20179.stderr
@@ -0,0 +1,10 @@
+
+T20179.hs:4:18: error:
+ • Expecting one more argument to ‘Maybe’
+ Expected a type, but ‘Maybe’ has kind ‘* -> *’
+ • In the type signature: slurmp :: [Maybe]
+ In the expression:
+ let
+ slurmp :: [Maybe]
+ slurmp = []
+ in pure []
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index a19ad09ec9..77ed446d95 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -531,3 +531,4 @@ test('T19470', only_ways(['ghci']), ghci_script, ['T19470.script'])
test('T19737', normal, compile, [''])
test('T19759', normal, compile, [''])
test('T20060', normal, compile, [''])
+test('T20179', normal, compile_fail, [''])