Commit 43751b24 authored by Alan Zimmerman's avatar Alan Zimmerman Committed by Ben Gamari

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
parent 898f34cd
......@@ -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
......
......@@ -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
......
......@@ -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:
......
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
import CheckUtils
import System.Environment( getArgs )
main::IO()
main = do
[libdir,fileName] <- getArgs
testOneFile libdir fileName
{-# 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)
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
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
# -----------------------------------------------------------------------------
#
# (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))
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment