From a3cd3a1d0d186f2aa4d0273c6b3e74a442de2ef0 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Sat, 18 May 2024 22:54:45 -0400
Subject: [PATCH] Add missing parenthesizePat in cvtp
We need to ensure that the output of `cvtp` is parenthesized (at precedence
`sigPrec`) so that any pattern signatures with a surrounding pattern signature
can parse correctly.
Fixes #24837.
---
compiler/GHC/ThToHs.hs | 3 ++-
testsuite/tests/th/T24837.hs | 6 ++++++
testsuite/tests/th/T24837.stderr | 4 ++++
testsuite/tests/th/all.T | 1 +
4 files changed, 13 insertions(+), 1 deletion(-)
create mode 100644 testsuite/tests/th/T24837.hs
create mode 100644 testsuite/tests/th/T24837.stderr
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 8f8f11d672e2..96be958fb9b7 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -1485,7 +1485,8 @@ cvtp (ListP ps) = do { ps' <- cvtPats ps
; return
$ ListPat noAnn ps'}
cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t
- ; return $ SigPat noAnn p' (mkHsPatSigType noAnn t') }
+ ; let pp = parenthesizePat sigPrec p'
+ ; return $ SigPat noAnn pp (mkHsPatSigType noAnn t') }
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
; return $ ViewPat noAnn e' p'}
cvtp (TypeP t) = do { t' <- cvtType t
diff --git a/testsuite/tests/th/T24837.hs b/testsuite/tests/th/T24837.hs
new file mode 100644
index 000000000000..c44c362f3205
--- /dev/null
+++ b/testsuite/tests/th/T24837.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T24837 where
+
+import Language.Haskell.TH
+
+$([d| f ((x :: Bool) :: Bool) = x |])
diff --git a/testsuite/tests/th/T24837.stderr b/testsuite/tests/th/T24837.stderr
new file mode 100644
index 000000000000..3d18269f322d
--- /dev/null
+++ b/testsuite/tests/th/T24837.stderr
@@ -0,0 +1,4 @@
+T24837.hs:6:2-37: Splicing declarations
+ [d| f ((x :: Bool) :: Bool) = x |]
+ ======>
+ f ((x :: Bool) :: Bool) = x
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 269624c2ac3d..bda61c4df471 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -614,3 +614,4 @@ test('T24557d', normal, compile_fail, [''])
test('T24557e', normal, compile, [''])
test('T24702a', normal, compile, [''])
test('T24702b', normal, compile, [''])
+test('T24837', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
--
GitLab