summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2015-10-25 20:19:38 +0100
committerBen Gamari <ben@smart-cactus.org>2015-10-25 20:19:38 +0100
commit43751b2436f370d956d8021b3cdd3eb77801470b (patch)
treec3eb56f9cd6f34bcc3ede20bb9b196fc140aa10a
parent898f34cdd0121d6bc145f75af2cf99f58542b558 (diff)
downloadhaskell-43751b2436f370d956d8021b3cdd3eb77801470b.tar.gz
Provide a utility to check API Annotations
It is difficult for GHC developers to know if they have broken the API Annotations. This patch provides a utility that can be used as a test to show up errors in the API Annotations. It is based on the current tests for ghc-api/annotations which can parse a file using the just-built GHC API, and check that no annotations are disconnected from the ParsedSource in the output. In addition, it should be able to dump the annotations to a file, so a new feature developer can check that all changes to the parser do provide annotations. Trac ticket: #10917 Test Plan: ./validate Reviewers: hvr, thomie, austin, bgamari Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D1368 GHC Trac Issues: #10917
-rw-r--r--ghc.mk3
-rw-r--r--testsuite/mk/boilerplate.mk2
-rw-r--r--testsuite/tests/ghc-api/annotations/Makefile107
-rw-r--r--testsuite/tests/ghc-api/annotations/boolFormula.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/exampleTest.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10255.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10268.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10269.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10278.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10280.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10307.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10309.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10312.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10354.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10357.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10358.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10396.hs7
-rw-r--r--testsuite/tests/ghc-api/annotations/t10399.hs7
-rw-r--r--utils/check-api-annotations/Main.hs112
-rw-r--r--utils/check-api-annotations/README18
-rw-r--r--utils/check-api-annotations/check-api-annotations.cabal25
-rw-r--r--utils/check-api-annotations/ghc.mk18
22 files changed, 195 insertions, 195 deletions
diff --git a/ghc.mk b/ghc.mk
index 611d8175fc..b2be25221f 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -538,6 +538,7 @@ ghc/stage2/package-data.mk: compiler/stage2/package-data.mk
# all the other libraries' package-data.mk files.
utils/haddock/dist/package-data.mk: compiler/stage2/package-data.mk
utils/ghctags/dist-install/package-data.mk: compiler/stage2/package-data.mk
+utils/check-api-annotations/dist-install/package-data.mk: compiler/stage2/package-data.mk
utils/mkUserGuidePart/dist/package-data.mk: compiler/stage2/package-data.mk
# add the final package.conf dependency: ghc-prim depends on RTS
@@ -652,6 +653,7 @@ BUILD_DIRS += utils/hsc2hs
BUILD_DIRS += utils/ghc-pkg
BUILD_DIRS += utils/testremove
BUILD_DIRS += utils/ghctags
+BUILD_DIRS += utils/check-api-annotations
BUILD_DIRS += utils/dll-split
BUILD_DIRS += utils/ghc-pwd
BUILD_DIRS += utils/ghc-cabal
@@ -705,6 +707,7 @@ ifneq "$(CrossCompiling) $(Stage1Only)" "NO NO"
BUILD_DIRS := $(filter-out utils/haddock,$(BUILD_DIRS))
BUILD_DIRS := $(filter-out utils/haddock/doc,$(BUILD_DIRS))
BUILD_DIRS := $(filter-out utils/ghctags,$(BUILD_DIRS))
+BUILD_DIRS := $(filter-out utils/check-api-annotations,$(BUILD_DIRS))
BUILD_DIRS := $(filter-out utils/mkUserGuidePart,$(BUILD_DIRS))
endif
endif # CLEANING
diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk
index b5039d5583..8872e52fef 100644
--- a/testsuite/mk/boilerplate.mk
+++ b/testsuite/mk/boilerplate.mk
@@ -176,6 +176,8 @@ ifeq "$(shell $(SHELL) -c 'python2 -c 0' 2> /dev/null && echo exists)" "exists"
PYTHON = python2
endif
+CHECK_API_ANNOTATIONS := $(abspath $(TOP)/../inplace/bin/check-api-annotations)
+
# -----------------------------------------------------------------------------
# configuration of TEST_HC
diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile
index 6cba9d4589..7ccb2a8c71 100644
--- a/testsuite/tests/ghc-api/annotations/Makefile
+++ b/testsuite/tests/ghc-api/annotations/Makefile
@@ -4,22 +4,9 @@ include $(TOP)/mk/test.mk
clean:
rm -f *.o *.hi
- rm -f annotations comments parseTree exampleTest
+ rm -f annotations comments parseTree
rm -f listcomps
- rm -f boolFormula
- rm -f t10255
- rm -f t10268
- rm -f t10269
- rm -f t10278
- rm -f t10280
- rm -f t10307
- rm -f t10309
- rm -f t10312
- rm -f t10354
- rm -f t10357
- rm -f t10358
- rm -f t10396
- rm -f t10399
+ rm -f stringSource
.PHONY: annotations
annotations:
@@ -41,11 +28,7 @@ comments:
.PHONY: exampleTest
exampleTest:
- rm -f exampleTest.o exampleTest.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_exampleTest \
- exampleTest
- ./exampleTest "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" AnnotationTuple
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" AnnotationTuple
.PHONY: listcomps
listcomps:
@@ -55,115 +38,59 @@ listcomps:
.PHONY: T10358
T10358:
- rm -f t10358.o t10358.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10358 \
- t10358
- ./t10358 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10358
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10358
.PHONY: T10396
T10396:
- rm -f t10396.o t10396.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10396 \
- t10396
- ./t10396 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10396
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10396
.PHONY: T10255
T10255:
- rm -f t10255.o t10255.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10255 \
- t10255
- ./t10255 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10255
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10255
.PHONY: T10357
T10357:
- rm -f t10357.o t10357.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10357 \
- t10357
- ./t10357 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10357
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10357
.PHONY: T10268
T10268:
- rm -f t10268.o t10268.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10268 \
- t10268
- ./t10268 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10268
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10268
.PHONY: T10280
T10280:
- rm -f t10280.o t10280.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10280 \
- t10280
- ./t10280 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10280
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10280
.PHONY: T10269
T10269:
- rm -f t10269.o t10269.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10269 \
- t10269
- ./t10269 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10269
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10269
.PHONY: T10312
T10312:
- rm -f t10312.o t10312.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10312 \
- t10312
- ./t10312 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10312
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10312
.PHONY: T10307
T10307:
- rm -f t10307.o t10307.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10307 \
- t10307
- ./t10307 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10307
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10307
.PHONY: T10309
T10309:
- rm -f t10309.o t10309.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10309 \
- t10309
- ./t10309 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10309
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10309
.PHONY: boolFormula
boolFormula:
- rm -f boolFormula.o boolFormula.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_boolFormula \
- boolFormula
- ./boolFormula "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" TestBoolFormula
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" TestBoolFormula
.PHONY: T10278
T10278:
- rm -f t10278.o t10278.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10278 \
- t10278
- ./t10278 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10278
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10278
.PHONY: T10354
T10354:
- rm -f t10354.o t10354.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10354 \
- t10354
- ./t10354 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10354
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10354
.PHONY: T10399
T10399:
- rm -f t10399.o t10399.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc \
- -outputdir tmp_T10399 \
- t10399
- ./t10399 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10399
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10399
.PHONY: T10313
T10313:
diff --git a/testsuite/tests/ghc-api/annotations/boolFormula.hs b/testsuite/tests/ghc-api/annotations/boolFormula.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/boolFormula.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/exampleTest.hs b/testsuite/tests/ghc-api/annotations/exampleTest.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/exampleTest.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10255.hs b/testsuite/tests/ghc-api/annotations/t10255.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10255.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10268.hs b/testsuite/tests/ghc-api/annotations/t10268.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10268.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10269.hs b/testsuite/tests/ghc-api/annotations/t10269.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10269.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10278.hs b/testsuite/tests/ghc-api/annotations/t10278.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10278.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10280.hs b/testsuite/tests/ghc-api/annotations/t10280.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10280.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10307.hs b/testsuite/tests/ghc-api/annotations/t10307.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10307.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10309.hs b/testsuite/tests/ghc-api/annotations/t10309.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10309.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10312.hs b/testsuite/tests/ghc-api/annotations/t10312.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10312.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10354.hs b/testsuite/tests/ghc-api/annotations/t10354.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10354.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10357.hs b/testsuite/tests/ghc-api/annotations/t10357.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10357.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10358.hs b/testsuite/tests/ghc-api/annotations/t10358.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10358.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10396.hs b/testsuite/tests/ghc-api/annotations/t10396.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10396.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/testsuite/tests/ghc-api/annotations/t10399.hs b/testsuite/tests/ghc-api/annotations/t10399.hs
deleted file mode 100644
index 346270e150..0000000000
--- a/testsuite/tests/ghc-api/annotations/t10399.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import CheckUtils
-import System.Environment( getArgs )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
diff --git a/utils/check-api-annotations/Main.hs b/utils/check-api-annotations/Main.hs
new file mode 100644
index 0000000000..7dc2eb3f77
--- /dev/null
+++ b/utils/check-api-annotations/Main.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE RankNTypes #-}
+
+import Data.Data
+import Data.List
+import GHC
+import DynFlags
+import Outputable
+import ApiAnnotation
+import System.Environment( getArgs )
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+main::IO()
+main = do
+ args <- getArgs
+ case args of
+ [libdir,fileName] -> testOneFile libdir fileName
+ _ -> putStrLn "invoke with the libdir and a file to parse."
+
+testOneFile :: FilePath -> String -> IO ()
+testOneFile libdir fileName = do
+ ((anns,cs),p) <- runGhc (Just libdir) $ do
+ dflags <- getSessionDynFlags
+ _ <- setSessionDynFlags dflags
+ let mn =mkModuleName fileName
+ addTarget Target { targetId = TargetModule mn
+ , targetAllowObjCode = True
+ , targetContents = Nothing }
+ _ <- load LoadAllTargets
+ modSum <- getModSummary mn
+ p <- parseModule modSum
+ return (pm_annotations p,p)
+
+ let sspans = Set.fromList $ getAllSrcSpans (pm_parsed_source p)
+
+ problems = filter (\(s,_a) -> not (Set.member s sspans))
+ $ getAnnSrcSpans (anns,cs)
+
+ exploded = [((kw,ss),[anchor])
+ | ((anchor,kw),sss) <- Map.toList anns,ss <- sss]
+
+ exploded' = Map.toList $ Map.fromListWith (++) exploded
+
+ problems' = filter (\(_,anchors)
+ -> not (any (\a -> Set.member a sspans) anchors))
+ exploded'
+
+ putStrLn "---Problems---------------------"
+ putStrLn (intercalate "\n" [showAnns $ Map.fromList $ map snd problems])
+ putStrLn "---Problems'--------------------"
+ putStrLn (intercalate "\n" [pp $ Map.fromList $ map fst problems'])
+ putStrLn "--------------------------------"
+ putStrLn (intercalate "\n" [showAnns anns])
+
+ where
+ getAnnSrcSpans :: ApiAnns -> [(SrcSpan,(ApiAnnKey,[SrcSpan]))]
+ getAnnSrcSpans (anns,_) = map (\a@((ss,_),_) -> (ss,a)) $ Map.toList anns
+
+ getAllSrcSpans :: (Data t) => t -> [SrcSpan]
+ getAllSrcSpans ast = everything (++) ([] `mkQ` getSrcSpan) ast
+ where
+ getSrcSpan :: SrcSpan -> [SrcSpan]
+ getSrcSpan ss = [ss]
+
+
+showAnns :: Map.Map ApiAnnKey [SrcSpan] -> String
+showAnns anns = "[\n" ++ (intercalate "\n"
+ $ map (\((s,k),v)
+ -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n"))
+ $ Map.toList anns)
+ ++ "]\n"
+
+pp :: (Outputable a) => a -> String
+pp a = showPpr unsafeGlobalDynFlags a
+
+
+-- ---------------------------------------------------------------------
+
+-- Copied from syb for the test
+
+
+-- | Generic queries of type \"r\",
+-- i.e., take any \"a\" and return an \"r\"
+--
+type GenericQ r = forall a. Data a => a -> r
+
+
+-- | Make a generic query;
+-- start from a type-specific case;
+-- return a constant otherwise
+--
+mkQ :: ( Typeable a
+ , Typeable b
+ )
+ => r
+ -> (b -> r)
+ -> a
+ -> r
+(r `mkQ` br) a = case cast a of
+ Just b -> br b
+ Nothing -> r
+
+
+
+-- | Summarise all nodes in top-down, left-to-right order
+everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
+
+-- Apply f to x to summarise top-level node;
+-- use gmapQ to recurse into immediate subterms;
+-- use ordinary foldl to reduce list of intermediate results
+
+everything k f x = foldl k (f x) (gmapQ (everything k f) x)
diff --git a/utils/check-api-annotations/README b/utils/check-api-annotations/README
new file mode 100644
index 0000000000..7c2815a403
--- /dev/null
+++ b/utils/check-api-annotations/README
@@ -0,0 +1,18 @@
+This programme is intended to be used by any GHC developers working on Parser.y
+or RdrHsSyn.hs, and who want to check that their changes do not break the API
+Annotations.
+
+It does a basic test that all annotations do make it to the final AST, and dumps
+a list of the annotations generated for a given file, so that they can be
+checked against the source being parsed for sanity.
+
+This utility is also intended to be used in tests, so that when new features are
+added the expected annotations are also captured.
+
+Usage
+
+In a test Makefile
+
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" FileToParse.hs
+
+See examples in (REPO_HOME)/testsuite/tests/ghc-api/annotations/Makefile
diff --git a/utils/check-api-annotations/check-api-annotations.cabal b/utils/check-api-annotations/check-api-annotations.cabal
new file mode 100644
index 0000000000..38c3f184f1
--- /dev/null
+++ b/utils/check-api-annotations/check-api-annotations.cabal
@@ -0,0 +1,25 @@
+Name: check-api-annotations
+Version: 0.1
+Copyright: XXX
+License: BSD3
+-- XXX License-File: LICENSE
+Author: XXX
+Maintainer: XXX
+Synopsis: XXX
+Description: XXX
+Category: Development
+build-type: Simple
+cabal-version: >=1.10
+
+Executable check-api-annotations
+ Default-Language: Haskell2010
+
+ Main-Is: Main.hs
+
+ Ghc-Options: -Wall
+
+ Build-Depends: base >= 4 && < 5,
+ containers,
+ Cabal >= 1.22 && <1.24,
+ directory,
+ ghc
diff --git a/utils/check-api-annotations/ghc.mk b/utils/check-api-annotations/ghc.mk
new file mode 100644
index 0000000000..61f896d3d7
--- /dev/null
+++ b/utils/check-api-annotations/ghc.mk
@@ -0,0 +1,18 @@
+# -----------------------------------------------------------------------------
+#
+# (c) 2009 The University of Glasgow
+#
+# This file is part of the GHC build system.
+#
+# To understand how the build system works and how to modify it, see
+# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture
+# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+utils/check-api-annotations_USES_CABAL = YES
+utils/check-api-annotations_PACKAGE = check-api-annotations
+utils/check-api-annotations_dist-install_PROGNAME = check-api-annotations
+utils/check-api-annotations_dist-install_INSTALL = NO
+utils/check-api-annotations_dist-install_INSTALL_INPLACE = YES
+$(eval $(call build-prog,utils/check-api-annotations,dist-install,2))