From 28827c513ea5020f03accc72aeb2168dbfd49b91 Mon Sep 17 00:00:00 2001
From: Xiaoyan Ren <xy.r@outlook.com>
Date: Mon, 8 Jan 2024 12:37:15 +0800
Subject: [PATCH] Fix prettyprinting of SCC pragmas
---
compiler/GHC/Types/SourceText.hs | 2 +-
libraries/template-haskell/Language/Haskell/TH/Ppr.hs | 2 +-
testsuite/tests/th/should_compile/T24081/T24081.stderr | 4 ++--
3 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/compiler/GHC/Types/SourceText.hs b/compiler/GHC/Types/SourceText.hs
index 5bf8c4e2cd25..45e2a7f97a77 100644
--- a/compiler/GHC/Types/SourceText.hs
+++ b/compiler/GHC/Types/SourceText.hs
@@ -322,4 +322,4 @@ instance Eq StringLiteral where
(StringLiteral _ a _) == (StringLiteral _ b _) = a == b
instance Outputable StringLiteral where
- ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl)
+ ppr sl = pprWithSourceText (sl_st sl) (doubleQuotes $ ftext $ sl_fs sl)
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 9f138fdf916d..3004c5567405 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -659,7 +659,7 @@ instance Ppr Pragma where
= text "{-# COMPLETE" <+> (fsep $ punctuate comma $ map (pprName' Applied) cls)
<+> maybe empty (\ty -> dcolon <+> pprName' Applied ty) mty <+> text "#-}"
ppr (SCCP nm str)
- = text "{-# SCC" <+> pprName' Applied nm <+> maybe empty text str <+> text "#-}"
+ = text "{-# SCC" <+> pprName' Applied nm <+> maybe empty pprString str <+> text "#-}"
------------------------------
instance Ppr Inline where
diff --git a/testsuite/tests/th/should_compile/T24081/T24081.stderr b/testsuite/tests/th/should_compile/T24081/T24081.stderr
index b39eec7244b9..bc48156c2fa8 100644
--- a/testsuite/tests/th/should_compile/T24081/T24081.stderr
+++ b/testsuite/tests/th/should_compile/T24081/T24081.stderr
@@ -6,10 +6,10 @@ Main.hs:5:1: Splicing declarations
Main.hs:6:1: Splicing declarations
y
======>
- {-# SCC g custom_name_g #-}
+ {-# SCC g "custom_name_g" #-}
g = 1
Main.hs:9:1-3: Splicing declarations
gen
======>
{-# SCC a #-}
- {-# SCC b custom_name_b #-}
+ {-# SCC b "custom_name_b" #-}
--
GitLab