[Git][ghc/ghc][master] EPA: Fix span for qualified multiline string

24 May 2026


      Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
3268c610 by Alan Zimmerman at 2026-05-23T18:42:30-04:00
EPA: Fix span for qualified multiline string

Fix the span for a qualified multiline string like

  Text."""
    I'm a multiline
    Text value
    !
  """

to extend to the end of the entire string, not just the first line.

Closes #27274

- - - - -


5 changed files:

- compiler/GHC/Parser/Lexer.x
- testsuite/tests/printer/Makefile
- + testsuite/tests/printer/PprQualifiedStrings.hs
- testsuite/tests/printer/all.T
- utils/check-exact/ExactPrint.hs


Changes:

=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -2274,8 +2274,9 @@ tok_quoted_label span buf len _buf2 = do
 tok_qstrings :: Action -> Action
 tok_qstrings lex_str span0 buf0 len0 endBuf0 = do
   let modName = ModuleName $ lexemeToFastString buf0 modNameLen
-  (src, meta, s) <- unITstring <$> lex_str strSpan strBuf strLen endBuf0
-  pure $ L span0 $ ITstring src meta{strMetaQualified = Just modName} s
+  (span1, src, meta, s) <- unITstring <$> lex_str strSpan strBuf strLen endBuf0
+  let span2 = mkPsSpan (psSpanStart span0) (psSpanEnd span1)
+  pure $ L span2 $ ITstring src meta{strMetaQualified = Just modName} s
   where
     -- The buffer/span starting at the string literal
     (strBuf, strSpanStart) =
@@ -2298,7 +2299,7 @@ tok_qstrings lex_str span0 buf0 len0 endBuf0 = do
     strSpan = mkPsSpan strSpanStart (psSpanEnd span0)
 
     unITstring = \case
-      L _ (ITstring src meta s) -> (src, meta, s)
+      L span1 (ITstring src meta s) -> (span1, src, meta, s)
       tok -> panic $ "tok_qstrings got unexpected token: " ++ show tok
 
 tok_char :: Action


=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -922,3 +922,8 @@ TestNamedDefaults:
 PprModifiers:
 	$(CHECK_PPR)   $(LIBDIR) PprModifiers.hs
 	$(CHECK_EXACT) $(LIBDIR) PprModifiers.hs
+
+.PHONY: PprQualifiedStrings
+PprQualifiedStrings:
+	$(CHECK_PPR)   $(LIBDIR) PprQualifiedStrings.hs
+	$(CHECK_EXACT) $(LIBDIR) PprQualifiedStrings.hs


=====================================
testsuite/tests/printer/PprQualifiedStrings.hs
=====================================
@@ -0,0 +1,75 @@
+{-# LANGUAGE MultilineStrings #-}
+{-# LANGUAGE QualifiedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- These are harvested from ../qualified-strings
+
+module PprQualifiedStrings where
+
+import Data.Typeable (Typeable, typeOf)
+import qualified Example.ByteStringAscii as Ascii
+import qualified Example.ByteStringUtf8 as Utf8
+import qualified Example.Text as Text
+
+exprs :: IO ()
+exprs = do
+  inspect "I'm a String" -- would be an ambiguous type error with OverloadedStrings
+  inspect Text."I'm a Text"
+  inspect Ascii."I'm an ASCII bytestring: 語"
+  inspect Utf8."I'm a UTF8 bytestring: 語"
+
+  inspect """
+    I'm a multiline
+    String value
+    !
+  """
+
+  inspect Text."""
+    I'm a multiline
+    Text value
+    !
+  """
+
+  inspect Text .  """
+    I'm a multiline
+    Text value
+  """
+
+    inspect Text .
+      """
+      I'm a multiline
+      Text value
+      """
+
+pats :: IO ()
+pats = do
+  let text = Text."foo" :: Text
+  case text of
+    Text."foo" -> putStrLn "Text.\"foo\" matched"
+    _ -> putStrLn "Text.\"foo\" did not match"
+
+  let ascii = Ascii."語" :: ByteString
+  case ascii of
+    Ascii."語" -> putStrLn "Ascii.\"語\" matched"
+    _ -> putStrLn "Ascii.\"語\" did not match"
+
+  let utf = Utf8."語" :: ByteString
+  case utf of
+    Utf8."語" -> putStrLn "Utf8.\"語\" matched"
+    _ -> putStrLn "Utf8.\"語\" did not match"
+
+th :: IO ()
+th =
+  $(do
+      foldr (\stmt acc -> [| $stmt >> $acc |]) [| pure () |] $
+        [ [| inspect Text."I'm a Text" |]
+        , [| inspect Ascii."I'm an ASCII bytestring: 語" |]
+        , [| inspect Utf8."I'm a Utf8 bytestring: 語" |]
+        , [|
+            inspect Text."""
+              I'm a multiline
+              Text string
+            """
+          |]
+        ]
+   )


=====================================
testsuite/tests/printer/all.T
=====================================
@@ -221,3 +221,4 @@ test('Test25885', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25885'])
 test('TestLevelImports', [ignore_stderr, req_ppr_deps], makefile_test, ['TestLevelImports'])
 test('TestNamedDefaults', [ignore_stderr, req_ppr_deps], makefile_test, ['TestNamedDefaults'])
 test('PprModifiers', [ignore_stderr,req_ppr_deps], makefile_test, ['PprModifiers'])
+test('PprQualifiedStrings', [ignore_stderr,req_ppr_deps], makefile_test, ['PprQualifiedStrings'])


=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -3145,6 +3145,12 @@ instance ExactPrint (HsExpr GhcPs) where
     body' <- markAnnotated body
     return (HsQual noExtField ctxt' body')
 
+  exact (HsQualLit _ (QualLit _ modu (HsQualString src fs))) = do
+    modu' <- markAnnotated modu
+    printStringAdvanceA "."
+    printSourceTextAA src (show (unpackFS fs))
+    return (HsQualLit noExtField (QualLit noExtField modu' (HsQualString src fs)))
+
   exact x = error $ "exact HsExpr for:" ++ showAst x
 
 -- ---------------------------------------------------------------------



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3268c610d7011d3b0d2a9357f59ab7ae...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3268c610d7011d3b0d2a9357f59ab7ae...
You're receiving this email because of your account on gitlab.haskell.org.

    

[Git][ghc/ghc][master] EPA: Fix span for qualified multiline string

Marge Bot (＠marge-bot)