summaryrefslogtreecommitdiff
path: root/utils/check-ppr
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2021-02-21 21:23:40 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-03-20 07:48:38 -0400
commit95275a5f25a2e70b71240d4756109180486af1b1 (patch)
treeeb4801bb0e00098b8b9d513479de4fbbd779ddac /utils/check-ppr
parentf940fd466a86c2f8e93237b36835797be3f3c898 (diff)
downloadhaskell-95275a5f25a2e70b71240d4756109180486af1b1.tar.gz
GHC Exactprint main commit
Metric Increase: T10370 parsing001 Updates haddock submodule
Diffstat (limited to 'utils/check-ppr')
-rw-r--r--utils/check-ppr/Main.hs21
1 files changed, 11 insertions, 10 deletions
diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs
index 9d025633ef..0559e20f10 100644
--- a/utils/check-ppr/Main.hs
+++ b/utils/check-ppr/Main.hs
@@ -35,11 +35,11 @@ testOneFile libdir fileName = do
p <- parseOneFile libdir fileName
let
origAst = showPprUnsafe
- $ showAstData BlankSrcSpan
+ $ showAstData BlankSrcSpan BlankApiAnnotations
$ eraseLayoutInfo (pm_parsed_source p)
pped = pragmas ++ "\n" ++ pp (pm_parsed_source p)
- anns = pm_annotations p
- pragmas = getPragmas anns
+ anns' = pm_annotations p
+ pragmas = getPragmas anns'
newFile = dropExtension fileName <.> "ppr" <.> takeExtension fileName
astFile = fileName <.> "ast"
@@ -52,7 +52,7 @@ testOneFile libdir fileName = do
let newAstStr :: String
newAstStr = showPprUnsafe
- $ showAstData BlankSrcSpan
+ $ showAstData BlankSrcSpan BlankApiAnnotations
$ eraseLayoutInfo (pm_parsed_source p')
writeFile newAstFile newAstStr
@@ -61,7 +61,7 @@ testOneFile libdir fileName = do
-- putStrLn "ASTs matched"
exitSuccess
else do
- putStrLn "AST Match Failed"
+ putStrLn "ppr AST Match Failed"
putStrLn "\n===================================\nOrig\n\n"
putStrLn origAst
putStrLn "\n===================================\nNew\n\n"
@@ -92,14 +92,15 @@ parseOneFile libdir fileName = do
parseModule modSum
getPragmas :: ApiAnns -> String
-getPragmas anns = pragmaStr
+getPragmas anns' = pragmaStr
where
- tokComment (L _ (AnnBlockComment s)) = s
- tokComment (L _ (AnnLineComment s)) = s
+ tokComment (L _ (AnnComment (AnnBlockComment s) _)) = s
+ tokComment (L _ (AnnComment (AnnLineComment s) _)) = s
tokComment _ = ""
- comments = map tokComment $ sortRealLocated $ apiAnnRogueComments anns
- pragmas = filter (\c -> isPrefixOf "{-#" c ) comments
+ cmp (L l1 _) (L l2 _) = compare (anchor l1) (anchor l2)
+ comments' = map tokComment $ sortBy cmp $ apiAnnRogueComments anns'
+ pragmas = filter (\c -> isPrefixOf "{-#" c ) comments'
pragmaStr = intercalate "\n" pragmas
pp :: (Outputable a) => a -> String