Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
3268c610
by Alan Zimmerman at 2026-05-23T18:42:30-04:00
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:
| ... | ... | @@ -2274,8 +2274,9 @@ tok_quoted_label span buf len _buf2 = do |
| 2274 | 2274 | tok_qstrings :: Action -> Action
|
| 2275 | 2275 | tok_qstrings lex_str span0 buf0 len0 endBuf0 = do
|
| 2276 | 2276 | let modName = ModuleName $ lexemeToFastString buf0 modNameLen
|
| 2277 | - (src, meta, s) <- unITstring <$> lex_str strSpan strBuf strLen endBuf0
|
|
| 2278 | - pure $ L span0 $ ITstring src meta{strMetaQualified = Just modName} s
|
|
| 2277 | + (span1, src, meta, s) <- unITstring <$> lex_str strSpan strBuf strLen endBuf0
|
|
| 2278 | + let span2 = mkPsSpan (psSpanStart span0) (psSpanEnd span1)
|
|
| 2279 | + pure $ L span2 $ ITstring src meta{strMetaQualified = Just modName} s
|
|
| 2279 | 2280 | where
|
| 2280 | 2281 | -- The buffer/span starting at the string literal
|
| 2281 | 2282 | (strBuf, strSpanStart) =
|
| ... | ... | @@ -2298,7 +2299,7 @@ tok_qstrings lex_str span0 buf0 len0 endBuf0 = do |
| 2298 | 2299 | strSpan = mkPsSpan strSpanStart (psSpanEnd span0)
|
| 2299 | 2300 | |
| 2300 | 2301 | unITstring = \case
|
| 2301 | - L _ (ITstring src meta s) -> (src, meta, s)
|
|
| 2302 | + L span1 (ITstring src meta s) -> (span1, src, meta, s)
|
|
| 2302 | 2303 | tok -> panic $ "tok_qstrings got unexpected token: " ++ show tok
|
| 2303 | 2304 | |
| 2304 | 2305 | tok_char :: Action
|
| ... | ... | @@ -922,3 +922,8 @@ TestNamedDefaults: |
| 922 | 922 | PprModifiers:
|
| 923 | 923 | $(CHECK_PPR) $(LIBDIR) PprModifiers.hs
|
| 924 | 924 | $(CHECK_EXACT) $(LIBDIR) PprModifiers.hs
|
| 925 | + |
|
| 926 | +.PHONY: PprQualifiedStrings
|
|
| 927 | +PprQualifiedStrings:
|
|
| 928 | + $(CHECK_PPR) $(LIBDIR) PprQualifiedStrings.hs
|
|
| 929 | + $(CHECK_EXACT) $(LIBDIR) PprQualifiedStrings.hs |
| 1 | +{-# LANGUAGE MultilineStrings #-}
|
|
| 2 | +{-# LANGUAGE QualifiedStrings #-}
|
|
| 3 | +{-# LANGUAGE TemplateHaskell #-}
|
|
| 4 | + |
|
| 5 | +-- These are harvested from ../qualified-strings
|
|
| 6 | + |
|
| 7 | +module PprQualifiedStrings where
|
|
| 8 | + |
|
| 9 | +import Data.Typeable (Typeable, typeOf)
|
|
| 10 | +import qualified Example.ByteStringAscii as Ascii
|
|
| 11 | +import qualified Example.ByteStringUtf8 as Utf8
|
|
| 12 | +import qualified Example.Text as Text
|
|
| 13 | + |
|
| 14 | +exprs :: IO ()
|
|
| 15 | +exprs = do
|
|
| 16 | + inspect "I'm a String" -- would be an ambiguous type error with OverloadedStrings
|
|
| 17 | + inspect Text."I'm a Text"
|
|
| 18 | + inspect Ascii."I'm an ASCII bytestring: 語"
|
|
| 19 | + inspect Utf8."I'm a UTF8 bytestring: 語"
|
|
| 20 | + |
|
| 21 | + inspect """
|
|
| 22 | + I'm a multiline
|
|
| 23 | + String value
|
|
| 24 | + !
|
|
| 25 | + """
|
|
| 26 | + |
|
| 27 | + inspect Text."""
|
|
| 28 | + I'm a multiline
|
|
| 29 | + Text value
|
|
| 30 | + !
|
|
| 31 | + """
|
|
| 32 | + |
|
| 33 | + inspect Text . """
|
|
| 34 | + I'm a multiline
|
|
| 35 | + Text value
|
|
| 36 | + """
|
|
| 37 | + |
|
| 38 | + inspect Text .
|
|
| 39 | + """
|
|
| 40 | + I'm a multiline
|
|
| 41 | + Text value
|
|
| 42 | + """
|
|
| 43 | + |
|
| 44 | +pats :: IO ()
|
|
| 45 | +pats = do
|
|
| 46 | + let text = Text."foo" :: Text
|
|
| 47 | + case text of
|
|
| 48 | + Text."foo" -> putStrLn "Text.\"foo\" matched"
|
|
| 49 | + _ -> putStrLn "Text.\"foo\" did not match"
|
|
| 50 | + |
|
| 51 | + let ascii = Ascii."語" :: ByteString
|
|
| 52 | + case ascii of
|
|
| 53 | + Ascii."語" -> putStrLn "Ascii.\"語\" matched"
|
|
| 54 | + _ -> putStrLn "Ascii.\"語\" did not match"
|
|
| 55 | + |
|
| 56 | + let utf = Utf8."語" :: ByteString
|
|
| 57 | + case utf of
|
|
| 58 | + Utf8."語" -> putStrLn "Utf8.\"語\" matched"
|
|
| 59 | + _ -> putStrLn "Utf8.\"語\" did not match"
|
|
| 60 | + |
|
| 61 | +th :: IO ()
|
|
| 62 | +th =
|
|
| 63 | + $(do
|
|
| 64 | + foldr (\stmt acc -> [| $stmt >> $acc |]) [| pure () |] $
|
|
| 65 | + [ [| inspect Text."I'm a Text" |]
|
|
| 66 | + , [| inspect Ascii."I'm an ASCII bytestring: 語" |]
|
|
| 67 | + , [| inspect Utf8."I'm a Utf8 bytestring: 語" |]
|
|
| 68 | + , [|
|
|
| 69 | + inspect Text."""
|
|
| 70 | + I'm a multiline
|
|
| 71 | + Text string
|
|
| 72 | + """
|
|
| 73 | + |]
|
|
| 74 | + ]
|
|
| 75 | + ) |
| ... | ... | @@ -221,3 +221,4 @@ test('Test25885', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25885']) |
| 221 | 221 | test('TestLevelImports', [ignore_stderr, req_ppr_deps], makefile_test, ['TestLevelImports'])
|
| 222 | 222 | test('TestNamedDefaults', [ignore_stderr, req_ppr_deps], makefile_test, ['TestNamedDefaults'])
|
| 223 | 223 | test('PprModifiers', [ignore_stderr,req_ppr_deps], makefile_test, ['PprModifiers'])
|
| 224 | +test('PprQualifiedStrings', [ignore_stderr,req_ppr_deps], makefile_test, ['PprQualifiedStrings']) |
| ... | ... | @@ -3145,6 +3145,12 @@ instance ExactPrint (HsExpr GhcPs) where |
| 3145 | 3145 | body' <- markAnnotated body
|
| 3146 | 3146 | return (HsQual noExtField ctxt' body')
|
| 3147 | 3147 | |
| 3148 | + exact (HsQualLit _ (QualLit _ modu (HsQualString src fs))) = do
|
|
| 3149 | + modu' <- markAnnotated modu
|
|
| 3150 | + printStringAdvanceA "."
|
|
| 3151 | + printSourceTextAA src (show (unpackFS fs))
|
|
| 3152 | + return (HsQualLit noExtField (QualLit noExtField modu' (HsQualString src fs)))
|
|
| 3153 | + |
|
| 3148 | 3154 | exact x = error $ "exact HsExpr for:" ++ showAst x
|
| 3149 | 3155 | |
| 3150 | 3156 | -- ---------------------------------------------------------------------
|