diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2019-01-22 23:29:25 +0200 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2019-01-27 08:32:12 -0500 |
commit | 3cf12e6081e7a9f0c3d515de52ffd079186816a5 (patch) | |
tree | adbdf5e5fe78a2da3954259a1cce19d7911cb001 /utils | |
parent | 5cb071af5b02b7433b2bb4d06062ac8b6fb387e8 (diff) | |
download | haskell-3cf12e6081e7a9f0c3d515de52ffd079186816a5.tar.gz |
check-api-annotations checks for annotation preceding its span
For an API annotation to be useful, it must not occur before the span
it is enclosed in.
So, for check-api-annotation output, a line such as
((Test16212.hs:3:22-36,AnnOpenP), [Test16212.hs:3:21]),
should be flagged as an error, as the AnnOpenP location of 3:21
precedes its enclosing span of 3:22-26.
This patch does this.
Closes #16217
Diffstat (limited to 'utils')
-rw-r--r-- | utils/check-api-annotations/Main.hs | 22 |
1 files changed, 17 insertions, 5 deletions
diff --git a/utils/check-api-annotations/Main.hs b/utils/check-api-annotations/Main.hs index 6b973e12e8..2597f5ec56 100644 --- a/utils/check-api-annotations/Main.hs +++ b/utils/check-api-annotations/Main.hs @@ -53,14 +53,24 @@ testOneFile libdir fileName = do problems'' = filter (\((a,_),_) -> a /= AnnEofPos) problems' - putStrLn "---Problems (should be empty list)---" + -- Check that every annotation location in 'vs' appears after + -- the start of the enclosing span 's' + comesBefore ((s,k),vs) = not $ all ok vs + where + ok v = (k == AnnEofPos) || (srcSpanStart s <= srcSpanStart v) + + precedingProblems = filter comesBefore $ Map.toList anns + + putStrLn "---Unattached Annotation Problems (should be empty list)---" putStrLn (intercalate "\n" [pp $ Map.fromList $ map fst problems'']) + putStrLn "---Ann before enclosing span problem (should be empty list)---" + putStrLn (showAnnsList precedingProblems) putStrLn "---Annotations-----------------------" putStrLn "-- SrcSpan the annotation is attached to, AnnKeywordId," putStrLn "-- list of locations the keyword item appears in" -- putStrLn (intercalate "\n" [showAnns anns]) putStrLn (showAnns anns) - if null problems'' + if null problems'' && null precedingProblems then exitSuccess else exitFailure @@ -73,11 +83,13 @@ testOneFile libdir fileName = do showAnns :: Map.Map ApiAnnKey [SrcSpan] -> String -showAnns anns = "[\n" ++ (intercalate ",\n" +showAnns anns = showAnnsList $ Map.toList anns + +showAnnsList :: [(ApiAnnKey, [SrcSpan])] -> String +showAnnsList annsList = "[\n" ++ (intercalate ",\n" $ map (\((s,k),v) - -- -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n")) -> ("((" ++ pp s ++ "," ++ show k ++"), " ++ pp v ++ ")")) - $ Map.toList anns) + annsList) ++ "\n]\n" pp :: (Outputable a) => a -> String |