Alan Zimmerman pushed to branch wip/az/T27274-epa-qualified-multiline-string at Glasgow Haskell Compiler / GHC Commits: 478c6325 by Alan Zimmerman at 2026-05-23T10:17:35+01: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/478c632598d4e6609b808eff0589828a... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/478c632598d4e6609b808eff0589828a... You're receiving this email because of your account on gitlab.haskell.org.