diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2023-01-15 22:10:36 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-01-23 04:50:33 -0500 |
| commit | fec7c2ea8242773b53b253d9536426f743443944 (patch) | |
| tree | 3cfe164e9505b5c7529530d970e18f4026cb807a /utils | |
| parent | a83ec778e44efcd4b56ce81ea0a183e6e73f026b (diff) | |
| download | haskell-fec7c2ea8242773b53b253d9536426f743443944.tar.gz | |
EPA: Add SourceText to HsOverLabel
To be able to capture string literals with possible escape codes as labels.
Close #22771
Diffstat (limited to 'utils')
| -rw-r--r-- | utils/check-exact/ExactPrint.hs | 11 | ||||
| -rw-r--r-- | utils/check-exact/Main.hs | 3 |
2 files changed, 10 insertions, 4 deletions
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index 0724da1ef9..be7bb54c0d 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/utils/check-exact/ExactPrint.hs @@ -2638,7 +2638,7 @@ instance ExactPrint (HsExpr GhcPs) where getAnnotationEntry (HsVar{}) = NoEntryVal getAnnotationEntry (HsUnboundVar an _) = fromAnn an getAnnotationEntry (HsRecSel{}) = NoEntryVal - getAnnotationEntry (HsOverLabel an _) = fromAnn an + getAnnotationEntry (HsOverLabel an _ _) = fromAnn an getAnnotationEntry (HsIPVar an _) = fromAnn an getAnnotationEntry (HsOverLit an _) = fromAnn an getAnnotationEntry (HsLit an _) = fromAnn an @@ -2676,7 +2676,7 @@ instance ExactPrint (HsExpr GhcPs) where setAnnotationAnchor a@(HsVar{}) _ _s = a setAnnotationAnchor (HsUnboundVar an a) anc cs = (HsUnboundVar (setAnchorEpa an anc cs) a) setAnnotationAnchor a@(HsRecSel{}) _ _s = a - setAnnotationAnchor (HsOverLabel an a) anc cs = (HsOverLabel (setAnchorEpa an anc cs) a) + setAnnotationAnchor (HsOverLabel an s a) anc cs = (HsOverLabel (setAnchorEpa an anc cs) s a) setAnnotationAnchor (HsIPVar an a) anc cs = (HsIPVar (setAnchorEpa an anc cs) a) setAnnotationAnchor (HsOverLit an a) anc cs = (HsOverLit (setAnchorEpa an anc cs) a) setAnnotationAnchor (HsLit an a) anc cs = (HsLit (setAnchorEpa an anc cs) a) @@ -2722,7 +2722,12 @@ instance ExactPrint (HsExpr GhcPs) where printStringAtAA l "_" >> return () printStringAtAA cb "`" >> return () return x - exact x@(HsOverLabel _ _) = withPpr x + exact x@(HsOverLabel _ src l) = do + printStringAtLsDelta (SameLine 0) "#" + case src of + NoSourceText -> printStringAtLsDelta (SameLine 0) (unpackFS l) + SourceText txt -> printStringAtLsDelta (SameLine 0) txt + return x exact x@(HsIPVar _ (HsIPName n)) = printStringAdvance ("?" ++ unpackFS n) >> return x diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs index d9d7feceac..c4eedde74a 100644 --- a/utils/check-exact/Main.hs +++ b/utils/check-exact/Main.hs @@ -204,7 +204,8 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/master/_b -- "../../testsuite/tests/printer/PprArrowLambdaCase.hs" Nothing -- "../../testsuite/tests/printer/Test16279.hs" Nothing -- "../../testsuite/tests/printer/HsDocTy.hs" Nothing - "../../testsuite/tests/printer/Test22765.hs" Nothing +-- "../../testsuite/tests/printer/Test22765.hs" Nothing + "../../testsuite/tests/printer/Test22771.hs" Nothing -- cloneT does not need a test, function can be retired |