From 1e9f90af7311c33de0f7f5b7dba594725596d675 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Wed, 27 Sep 2017 15:22:37 -0400 Subject: Move check-ppr and check-api-annotations to testsuite/utils These are needed by the testsuite and consequently must be shipped in the testsuite tarball to ensure that we can test binary distributions. See #13897. Test Plan: Validate Reviewers: austin Subscribers: snowleopard, rwbarton, thomie GHC Trac Issues: #13897 Differential Revision: https://phabricator.haskell.org/D4039 --- .gitignore | 1 + Makefile | 10 +- ghc.mk | 34 +++++- testsuite/utils/check-api-annotations/Main.hs | 122 +++++++++++++++++++++ testsuite/utils/check-api-annotations/README | 103 +++++++++++++++++ .../check-api-annotations.cabal | 29 +++++ testsuite/utils/check-api-annotations/ghc.mk | 20 ++++ testsuite/utils/check-ppr/Main.hs | 105 ++++++++++++++++++ testsuite/utils/check-ppr/README | 26 +++++ testsuite/utils/check-ppr/check-ppr.cabal | 31 ++++++ testsuite/utils/check-ppr/ghc.mk | 20 ++++ utils/check-api-annotations/Main.hs | 122 --------------------- utils/check-api-annotations/README | 103 ----------------- .../check-api-annotations.cabal | 29 ----- utils/check-api-annotations/ghc.mk | 18 --- utils/check-ppr/Main.hs | 105 ------------------ utils/check-ppr/README | 26 ----- utils/check-ppr/check-ppr.cabal | 31 ------ utils/check-ppr/ghc.mk | 18 --- 19 files changed, 492 insertions(+), 461 deletions(-) create mode 100644 testsuite/utils/check-api-annotations/Main.hs create mode 100644 testsuite/utils/check-api-annotations/README create mode 100644 testsuite/utils/check-api-annotations/check-api-annotations.cabal create mode 100644 testsuite/utils/check-api-annotations/ghc.mk create mode 100644 testsuite/utils/check-ppr/Main.hs create mode 100644 testsuite/utils/check-ppr/README create mode 100644 testsuite/utils/check-ppr/check-ppr.cabal create mode 100644 testsuite/utils/check-ppr/ghc.mk delete mode 100644 utils/check-api-annotations/Main.hs delete mode 100644 utils/check-api-annotations/README delete mode 100644 utils/check-api-annotations/check-api-annotations.cabal delete mode 100644 utils/check-api-annotations/ghc.mk delete mode 100644 utils/check-ppr/Main.hs delete mode 100644 utils/check-ppr/README delete mode 100644 utils/check-ppr/check-ppr.cabal delete mode 100644 utils/check-ppr/ghc.mk diff --git a/.gitignore b/.gitignore index 245b2a527d..710c6bfd6f 100644 --- a/.gitignore +++ b/.gitignore @@ -76,6 +76,7 @@ _darcs/ /libraries/dist-haddock/ /rts/dist/ /utils/*/dist*/ +/testsuite/utils/*/dist-install/ /compiler/stage1/ /compiler/stage2/ /compiler/stage3/ diff --git a/Makefile b/Makefile index 8046e36e14..cffd4ec914 100644 --- a/Makefile +++ b/Makefile @@ -215,13 +215,17 @@ endif # out-of-date, it is useful if Phabricator, via a normal `./validate` and `make # test`, runs each test at least once. .PHONY: fasttest -fasttest: +fasttest: testsuite_utils $(MAKE) -C testsuite/tests CLEANUP=1 SUMMARY_FILE=../../testsuite_summary.txt fast .PHONY: test -test: +test: testsuite_utils $(MAKE) -C testsuite/tests CLEANUP=1 SUMMARY_FILE=../../testsuite_summary.txt .PHONY: slowtest fulltest -slowtest fulltest: +slowtest fulltest: testsuite_utils $(MAKE) -C testsuite/tests CLEANUP=1 SUMMARY_FILE=../../testsuite_summary.txt slow + +.PHONY: testsuite_utils +testsuite_utils: + $(MAKE) -f ghc.mk testsuite_utils diff --git a/ghc.mk b/ghc.mk index 8918441b83..c3edc5eb1a 100644 --- a/ghc.mk +++ b/ghc.mk @@ -560,8 +560,8 @@ 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/check-ppr/dist-install/package-data.mk: compiler/stage2/package-data.mk +testsuite/utils/check-api-annotations/dist-install/package-data.mk: compiler/stage2/package-data.mk +testsuite/utils/check-ppr/dist-install/package-data.mk: compiler/stage2/package-data.mk # add the final package.conf dependency: ghc-prim depends on RTS libraries/ghc-prim/dist-install/package-data.mk : rts/dist/package.conf.inplace @@ -684,8 +684,6 @@ 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/check-ppr BUILD_DIRS += utils/ghc-cabal BUILD_DIRS += utils/hpc BUILD_DIRS += utils/runghc @@ -695,6 +693,19 @@ BUILD_DIRS += utils/count_lines BUILD_DIRS += utils/compare_sizes BUILD_DIRS += iserv +# If we are in a tree derived from a source tarball the testsuite/ directory may +# not exist, meaning we can't build the testsuite/utils packages. +ifeq "$(wildcard testsuite/Makefile)" "" +HaveTestsuite = NO +else +HaveTestsuite = YES +endif + +ifeq "$(HaveTestsuite)" "YES" +BUILD_DIRS += testsuite/utils/check-api-annotations +BUILD_DIRS += testsuite/utils/check-ppr +endif + # ---------------------------------------------- # Actually include the sub-ghc.mk's @@ -734,8 +745,8 @@ ifneq "$(CrossCompiling) $(Stage1Only)" "NO NO" # See Note [No stage2 packages when CrossCompiling or Stage1Only]. # See Note [Stage1Only vs stage=1] in mk/config.mk.in. BUILD_DIRS := $(filter-out utils/ghctags,$(BUILD_DIRS)) -BUILD_DIRS := $(filter-out utils/check-api-annotations,$(BUILD_DIRS)) -BUILD_DIRS := $(filter-out utils/check-ppr,$(BUILD_DIRS)) +BUILD_DIRS := $(filter-out testsuite/utils/check-api-annotations,$(BUILD_DIRS)) +BUILD_DIRS := $(filter-out testsuite/utils/check-ppr,$(BUILD_DIRS)) endif endif # CLEANING @@ -1572,3 +1583,14 @@ phase_0_builds: $(utils/deriveConstants_dist_depfile_c_asm) .PHONY: phase_1_builds phase_1_builds: $(PACKAGE_DATA_MKS) + +# Various utilities in testsuite/utils which must be built before +# the testsuite is run. +.PHONY: testsuite_utils +testsuite_utils: +ifeq "$(HaveTestsuite)" "NO" + @echo "The testsuite/ directory appears to be unavailable." + @echo "" + @echo "If this tree is from a source tarball please download and extract" + @echo "the corresponding testsuite tarball." +endif diff --git a/testsuite/utils/check-api-annotations/Main.hs b/testsuite/utils/check-api-annotations/Main.hs new file mode 100644 index 0000000000..6b973e12e8 --- /dev/null +++ b/testsuite/utils/check-api-annotations/Main.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE RankNTypes #-} + +import Data.Data +import Data.List +import GHC +import DynFlags +import Outputable +import ApiAnnotation +import System.Environment( getArgs ) +import System.Exit +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 + let modByFile m = + case ml_hs_file $ ms_location m of + Nothing -> False + Just fn -> fn == fileName + ((anns,_cs),p) <- runGhc (Just libdir) $ do + dflags <- getSessionDynFlags + _ <- setSessionDynFlags dflags + addTarget Target { targetId = TargetFile fileName Nothing + , targetAllowObjCode = True + , targetContents = Nothing } + _ <- load LoadAllTargets + graph <- getModuleGraph + let modSum = + case filter modByFile (mgModSummaries graph) of + [x] -> x + xs -> error $ "Can't find module, got:" + ++ show (map (ml_hs_file . ms_location) xs) + p <- parseModule modSum + return (pm_annotations p,p) + + let sspans = Set.fromList $ getAllSrcSpans (pm_parsed_source p) + + 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' + + problems'' = filter (\((a,_),_) -> a /= AnnEofPos) problems' + + putStrLn "---Problems (should be empty list)---" + putStrLn (intercalate "\n" [pp $ Map.fromList $ map fst problems'']) + 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'' + then exitSuccess + else exitFailure + + where + 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")) + -> ("((" ++ pp s ++ "," ++ show k ++"), " ++ pp v ++ ")")) + $ Map.toList anns) + ++ "\n]\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/testsuite/utils/check-api-annotations/README b/testsuite/utils/check-api-annotations/README new file mode 100644 index 0000000000..fcadc50ff6 --- /dev/null +++ b/testsuite/utils/check-api-annotations/README @@ -0,0 +1,103 @@ +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 + + +Description of operation +------------------------ + +The programme is called with the name of a haskell source file. + +It uses the GHC API to load and parse this, and extracts the API annotations. + +These are of the form + + Map.Map ApiAnnKey [SrcSpan] + +where + + type ApiAnnKey = (SrcSpan,AnnKeywordId) + +So an annotation is a key comprising the parent SrcSpan in the ParsedSource +together with an AnnKeywordId, and this maps to a list of locations where the +specific keyword item occurs in the original source. + +The utility extracts all SrcSpans in the ParsedSource, and makes sure that for +every ApiAnnKey the SrcSpan is actually present in the final ParsedSource. This +is to ensure that when a given parser production is postprocessed anywhere along +the line the relevant SrcSpan is not discarded, thus detaching the annotation +from the final output. + +It also provides a list of each ApiAnnKey and the corresponding source +locations, so these can be checked against the original source for correctness. + +Example +------- + +Test10255.hs in the ghc-api/annotations tests has the following source + +------------------------------ +1:{-# LANGUAGE ScopedTypeVariables #-} +2:module Test10255 where +3: +4:import Data.Maybe +5: +6:fob (f :: (Maybe t -> Int)) = +7: undefined +------------------------------ + +The output of this utility is + +------------------------------------------------------------------------ +---Problems (should be empty list)--- +[] +---Annotations----------------------- +-- SrcSpan the annotation is attached to, AnnKeywordId, +-- list of locations the keyword item appears in +[ +((Test10255.hs:1:1,AnnModule), [Test10255.hs:2:1-6]), +((Test10255.hs:1:1,AnnWhere), [Test10255.hs:2:18-22]), +((Test10255.hs:4:1-17,AnnImport), [Test10255.hs:4:1-6]), +((Test10255.hs:4:1-17,AnnSemi), [Test10255.hs:6:1]), +((Test10255.hs:(6,1)-(7,11),AnnEqual), [Test10255.hs:6:29]), +((Test10255.hs:(6,1)-(7,11),AnnFunId), [Test10255.hs:6:1-3]), +((Test10255.hs:(6,1)-(7,11),AnnSemi), [Test10255.hs:8:1]), +((Test10255.hs:6:5-27,AnnCloseP), [Test10255.hs:6:27]), +((Test10255.hs:6:5-27,AnnOpenP), [Test10255.hs:6:5]), +((Test10255.hs:6:6-26,AnnDcolon), [Test10255.hs:6:8-9]), +((Test10255.hs:6:11-26,AnnCloseP), [Test10255.hs:6:26]), +((Test10255.hs:6:11-26,AnnOpenP), [Test10255.hs:6:11]), +((Test10255.hs:6:12-18,AnnRarrow), [Test10255.hs:6:20-21]), +((Test10255.hs:6:12-25,AnnRarrow), [Test10255.hs:6:20-21]), +((,AnnEofPos), [Test10255.hs:8:1]) +] +------------------------------------------------------------------------ + +To interpret this, firstly the problems list is empty, so there are not +annotations that do not appear in the final AST. + +Secondly, the list of annotations and locations can be checked against the test +source code to ensure that every AnnKeywordId does in fact appear. + +It will return a zero exit code if the list of problems is empty, non-zero +otherwise. + +Note: In some cases, such as T10269 in the ghc-api/annotations tests the list is +non-empty, due to postprocessing of the parsed result. In general this should +only happen for an `AnnVal` and if it does the actual annotations provided need +to be inspected to check that an equivalent annotation is provided. diff --git a/testsuite/utils/check-api-annotations/check-api-annotations.cabal b/testsuite/utils/check-api-annotations/check-api-annotations.cabal new file mode 100644 index 0000000000..880f4d6603 --- /dev/null +++ b/testsuite/utils/check-api-annotations/check-api-annotations.cabal @@ -0,0 +1,29 @@ +Name: check-api-annotations +Version: 0.1 +Copyright: XXX +License: BSD3 +-- XXX License-File: LICENSE +Author: XXX +Maintainer: XXX +Synopsis: A utilities for checking the consistency of GHC's API annotations. +Description: + This utility is used to check the consistency between GHC's syntax tree + and API annotations used to track token-level details of the original + source file. See @utils/check-api-annotations/README@ in GHC's source + distribution for details. +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 >= 2.0 && < 2.1, + directory, + ghc diff --git a/testsuite/utils/check-api-annotations/ghc.mk b/testsuite/utils/check-api-annotations/ghc.mk new file mode 100644 index 0000000000..f2af7d0d2c --- /dev/null +++ b/testsuite/utils/check-api-annotations/ghc.mk @@ -0,0 +1,20 @@ +# ----------------------------------------------------------------------------- +# +# (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 +# +# ----------------------------------------------------------------------------- + +testsuite/utils/check-api-annotations_USES_CABAL = YES +testsuite/utils/check-api-annotations_PACKAGE = check-api-annotations +testsuite/utils/check-api-annotations_dist-install_PROGNAME = check-api-annotations +testsuite/utils/check-api-annotations_dist-install_INSTALL = NO +testsuite/utils/check-api-annotations_dist-install_INSTALL_INPLACE = YES +$(eval $(call build-prog,testsuite/utils/check-api-annotations,dist-install,2)) + +testsuite_utils: $(testsuite/utils/check-api-annotations_dist-install_INPLACE) diff --git a/testsuite/utils/check-ppr/Main.hs b/testsuite/utils/check-ppr/Main.hs new file mode 100644 index 0000000000..a5aeee2f1d --- /dev/null +++ b/testsuite/utils/check-ppr/Main.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +import Data.List +import SrcLoc +import GHC hiding (moduleName) +import HsDumpAst +import DynFlags +import Outputable hiding (space) +import System.Environment( getArgs ) +import System.Exit +import System.FilePath + +import qualified Data.Map as Map + +usage :: String +usage = unlines + [ "usage: check-ppr (libdir) (file)" + , "" + , "where libdir is the GHC library directory (e.g. the output of" + , "ghc --print-libdir) and file is the file to parse." + ] + +main :: IO() +main = do + args <- getArgs + case args of + [libdir,fileName] -> testOneFile libdir fileName + _ -> putStrLn usage + +testOneFile :: FilePath -> String -> IO () +testOneFile libdir fileName = do + p <- parseOneFile libdir fileName + let + origAst = showSDoc unsafeGlobalDynFlags + $ showAstData BlankSrcSpan (pm_parsed_source p) + pped = pragmas ++ "\n" ++ pp (pm_parsed_source p) + anns = pm_annotations p + pragmas = getPragmas anns + + newFile = dropExtension fileName <.> "ppr" <.> takeExtension fileName + astFile = fileName <.> "ast" + newAstFile = fileName <.> "ast.new" + + writeFile astFile origAst + writeFile newFile pped + + p' <- parseOneFile libdir newFile + + let newAstStr :: String + newAstStr = showSDoc unsafeGlobalDynFlags + $ showAstData BlankSrcSpan (pm_parsed_source p') + writeFile newAstFile newAstStr + + if origAst == newAstStr + then do + -- putStrLn "ASTs matched" + exitSuccess + else do + putStrLn "AST Match Failed" + putStrLn "\n===================================\nOrig\n\n" + putStrLn origAst + putStrLn "\n===================================\nNew\n\n" + putStrLn newAstStr + exitFailure + + +parseOneFile :: FilePath -> FilePath -> IO ParsedModule +parseOneFile libdir fileName = do + let modByFile m = + case ml_hs_file $ ms_location m of + Nothing -> False + Just fn -> fn == fileName + runGhc (Just libdir) $ do + dflags <- getSessionDynFlags + let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream + _ <- setSessionDynFlags dflags2 + addTarget Target { targetId = TargetFile fileName Nothing + , targetAllowObjCode = True + , targetContents = Nothing } + _ <- load LoadAllTargets + graph <- getModuleGraph + let + modSum = case filter modByFile (mgModSummaries graph) of + [x] -> x + xs -> error $ "Can't find module, got:" + ++ show (map (ml_hs_file . ms_location) xs) + parseModule modSum + +getPragmas :: ApiAnns -> String +getPragmas anns = pragmaStr + where + tokComment (L _ (AnnBlockComment s)) = s + tokComment (L _ (AnnLineComment s)) = s + tokComment _ = "" + + comments = case Map.lookup noSrcSpan (snd anns) of + Nothing -> [] + Just cl -> map tokComment $ sortLocated cl + pragmas = filter (\c -> isPrefixOf "{-#" c ) comments + pragmaStr = intercalate "\n" pragmas + +pp :: (Outputable a) => a -> String +pp a = showPpr unsafeGlobalDynFlags a + + diff --git a/testsuite/utils/check-ppr/README b/testsuite/utils/check-ppr/README new file mode 100644 index 0000000000..f9b502e4a7 --- /dev/null +++ b/testsuite/utils/check-ppr/README @@ -0,0 +1,26 @@ + +This programme is intended to be used by any GHC developers working on the AST +and/or pretty printer by providing a way to check that the same AST is generated +from the pretty printed AST as from the original source. + +i.e., it checks whether + + parse (ppr (parse s)) === parse s + + +This utility is also intended to be used in tests, so that when new features are +added the ability to round-trip the AST via ppr is tested. + +Usage + +In a test Makefile + + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" FileToParse.hs + +See examples in (REPO_HOME)/testsuite/tests/printer/Makefile + +The utility generates the following files for ToBeTested.hs + + - ToBeTested.ppr.hs : the ppr result + - ToBeTested.hs.ast : the AST of the original source + - ToBeTested.hs.ast.new : the AST of the re-parsed ppr source diff --git a/testsuite/utils/check-ppr/check-ppr.cabal b/testsuite/utils/check-ppr/check-ppr.cabal new file mode 100644 index 0000000000..584558b3ff --- /dev/null +++ b/testsuite/utils/check-ppr/check-ppr.cabal @@ -0,0 +1,31 @@ +Name: check-ppr +Version: 0.1 +Copyright: XXX +License: BSD3 +-- XXX License-File: LICENSE +Author: XXX +Maintainer: XXX +Synopsis: A utilities for checking the consistency of GHC's pretty printer +Description: + This utility is used to check the consistency of the GHC pretty printer, by + parsing a file, pretty printing it, and then re-parsing the pretty printed + version. See @utils/check-ppr/README@ in GHC's source distribution for + details. +Category: Development +build-type: Simple +cabal-version: >=1.10 + +Executable check-ppr + Default-Language: Haskell2010 + + Main-Is: Main.hs + + Ghc-Options: -Wall + + Build-Depends: base >= 4 && < 5, + bytestring, + containers, + Cabal >= 2.0 && < 2.1, + directory, + filepath, + ghc diff --git a/testsuite/utils/check-ppr/ghc.mk b/testsuite/utils/check-ppr/ghc.mk new file mode 100644 index 0000000000..62b8de6505 --- /dev/null +++ b/testsuite/utils/check-ppr/ghc.mk @@ -0,0 +1,20 @@ +# ----------------------------------------------------------------------------- +# +# (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 +# +# ----------------------------------------------------------------------------- + +testsuite/utils/check-ppr_USES_CABAL = YES +testsuite/utils/check-ppr_PACKAGE = check-ppr +testsuite/utils/check-ppr_dist-install_PROGNAME = check-ppr +testsuite/utils/check-ppr_dist-install_INSTALL = NO +testsuite/utils/check-ppr_dist-install_INSTALL_INPLACE = YES +$(eval $(call build-prog,testsuite/utils/check-ppr,dist-install,2)) + +testsuite_utils: $(testsuite/utils/check-ppr_dist-install_INPLACE) diff --git a/utils/check-api-annotations/Main.hs b/utils/check-api-annotations/Main.hs deleted file mode 100644 index 6b973e12e8..0000000000 --- a/utils/check-api-annotations/Main.hs +++ /dev/null @@ -1,122 +0,0 @@ -{-# LANGUAGE RankNTypes #-} - -import Data.Data -import Data.List -import GHC -import DynFlags -import Outputable -import ApiAnnotation -import System.Environment( getArgs ) -import System.Exit -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 - let modByFile m = - case ml_hs_file $ ms_location m of - Nothing -> False - Just fn -> fn == fileName - ((anns,_cs),p) <- runGhc (Just libdir) $ do - dflags <- getSessionDynFlags - _ <- setSessionDynFlags dflags - addTarget Target { targetId = TargetFile fileName Nothing - , targetAllowObjCode = True - , targetContents = Nothing } - _ <- load LoadAllTargets - graph <- getModuleGraph - let modSum = - case filter modByFile (mgModSummaries graph) of - [x] -> x - xs -> error $ "Can't find module, got:" - ++ show (map (ml_hs_file . ms_location) xs) - p <- parseModule modSum - return (pm_annotations p,p) - - let sspans = Set.fromList $ getAllSrcSpans (pm_parsed_source p) - - 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' - - problems'' = filter (\((a,_),_) -> a /= AnnEofPos) problems' - - putStrLn "---Problems (should be empty list)---" - putStrLn (intercalate "\n" [pp $ Map.fromList $ map fst problems'']) - 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'' - then exitSuccess - else exitFailure - - where - 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")) - -> ("((" ++ pp s ++ "," ++ show k ++"), " ++ pp v ++ ")")) - $ Map.toList anns) - ++ "\n]\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 deleted file mode 100644 index fcadc50ff6..0000000000 --- a/utils/check-api-annotations/README +++ /dev/null @@ -1,103 +0,0 @@ -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 - - -Description of operation ------------------------- - -The programme is called with the name of a haskell source file. - -It uses the GHC API to load and parse this, and extracts the API annotations. - -These are of the form - - Map.Map ApiAnnKey [SrcSpan] - -where - - type ApiAnnKey = (SrcSpan,AnnKeywordId) - -So an annotation is a key comprising the parent SrcSpan in the ParsedSource -together with an AnnKeywordId, and this maps to a list of locations where the -specific keyword item occurs in the original source. - -The utility extracts all SrcSpans in the ParsedSource, and makes sure that for -every ApiAnnKey the SrcSpan is actually present in the final ParsedSource. This -is to ensure that when a given parser production is postprocessed anywhere along -the line the relevant SrcSpan is not discarded, thus detaching the annotation -from the final output. - -It also provides a list of each ApiAnnKey and the corresponding source -locations, so these can be checked against the original source for correctness. - -Example -------- - -Test10255.hs in the ghc-api/annotations tests has the following source - ------------------------------- -1:{-# LANGUAGE ScopedTypeVariables #-} -2:module Test10255 where -3: -4:import Data.Maybe -5: -6:fob (f :: (Maybe t -> Int)) = -7: undefined ------------------------------- - -The output of this utility is - ------------------------------------------------------------------------- ----Problems (should be empty list)--- -[] ----Annotations----------------------- --- SrcSpan the annotation is attached to, AnnKeywordId, --- list of locations the keyword item appears in -[ -((Test10255.hs:1:1,AnnModule), [Test10255.hs:2:1-6]), -((Test10255.hs:1:1,AnnWhere), [Test10255.hs:2:18-22]), -((Test10255.hs:4:1-17,AnnImport), [Test10255.hs:4:1-6]), -((Test10255.hs:4:1-17,AnnSemi), [Test10255.hs:6:1]), -((Test10255.hs:(6,1)-(7,11),AnnEqual), [Test10255.hs:6:29]), -((Test10255.hs:(6,1)-(7,11),AnnFunId), [Test10255.hs:6:1-3]), -((Test10255.hs:(6,1)-(7,11),AnnSemi), [Test10255.hs:8:1]), -((Test10255.hs:6:5-27,AnnCloseP), [Test10255.hs:6:27]), -((Test10255.hs:6:5-27,AnnOpenP), [Test10255.hs:6:5]), -((Test10255.hs:6:6-26,AnnDcolon), [Test10255.hs:6:8-9]), -((Test10255.hs:6:11-26,AnnCloseP), [Test10255.hs:6:26]), -((Test10255.hs:6:11-26,AnnOpenP), [Test10255.hs:6:11]), -((Test10255.hs:6:12-18,AnnRarrow), [Test10255.hs:6:20-21]), -((Test10255.hs:6:12-25,AnnRarrow), [Test10255.hs:6:20-21]), -((,AnnEofPos), [Test10255.hs:8:1]) -] ------------------------------------------------------------------------- - -To interpret this, firstly the problems list is empty, so there are not -annotations that do not appear in the final AST. - -Secondly, the list of annotations and locations can be checked against the test -source code to ensure that every AnnKeywordId does in fact appear. - -It will return a zero exit code if the list of problems is empty, non-zero -otherwise. - -Note: In some cases, such as T10269 in the ghc-api/annotations tests the list is -non-empty, due to postprocessing of the parsed result. In general this should -only happen for an `AnnVal` and if it does the actual annotations provided need -to be inspected to check that an equivalent annotation is provided. diff --git a/utils/check-api-annotations/check-api-annotations.cabal b/utils/check-api-annotations/check-api-annotations.cabal deleted file mode 100644 index 880f4d6603..0000000000 --- a/utils/check-api-annotations/check-api-annotations.cabal +++ /dev/null @@ -1,29 +0,0 @@ -Name: check-api-annotations -Version: 0.1 -Copyright: XXX -License: BSD3 --- XXX License-File: LICENSE -Author: XXX -Maintainer: XXX -Synopsis: A utilities for checking the consistency of GHC's API annotations. -Description: - This utility is used to check the consistency between GHC's syntax tree - and API annotations used to track token-level details of the original - source file. See @utils/check-api-annotations/README@ in GHC's source - distribution for details. -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 >= 2.0 && < 2.1, - directory, - ghc diff --git a/utils/check-api-annotations/ghc.mk b/utils/check-api-annotations/ghc.mk deleted file mode 100644 index 61f896d3d7..0000000000 --- a/utils/check-api-annotations/ghc.mk +++ /dev/null @@ -1,18 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (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)) diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs deleted file mode 100644 index a5aeee2f1d..0000000000 --- a/utils/check-ppr/Main.hs +++ /dev/null @@ -1,105 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -import Data.List -import SrcLoc -import GHC hiding (moduleName) -import HsDumpAst -import DynFlags -import Outputable hiding (space) -import System.Environment( getArgs ) -import System.Exit -import System.FilePath - -import qualified Data.Map as Map - -usage :: String -usage = unlines - [ "usage: check-ppr (libdir) (file)" - , "" - , "where libdir is the GHC library directory (e.g. the output of" - , "ghc --print-libdir) and file is the file to parse." - ] - -main :: IO() -main = do - args <- getArgs - case args of - [libdir,fileName] -> testOneFile libdir fileName - _ -> putStrLn usage - -testOneFile :: FilePath -> String -> IO () -testOneFile libdir fileName = do - p <- parseOneFile libdir fileName - let - origAst = showSDoc unsafeGlobalDynFlags - $ showAstData BlankSrcSpan (pm_parsed_source p) - pped = pragmas ++ "\n" ++ pp (pm_parsed_source p) - anns = pm_annotations p - pragmas = getPragmas anns - - newFile = dropExtension fileName <.> "ppr" <.> takeExtension fileName - astFile = fileName <.> "ast" - newAstFile = fileName <.> "ast.new" - - writeFile astFile origAst - writeFile newFile pped - - p' <- parseOneFile libdir newFile - - let newAstStr :: String - newAstStr = showSDoc unsafeGlobalDynFlags - $ showAstData BlankSrcSpan (pm_parsed_source p') - writeFile newAstFile newAstStr - - if origAst == newAstStr - then do - -- putStrLn "ASTs matched" - exitSuccess - else do - putStrLn "AST Match Failed" - putStrLn "\n===================================\nOrig\n\n" - putStrLn origAst - putStrLn "\n===================================\nNew\n\n" - putStrLn newAstStr - exitFailure - - -parseOneFile :: FilePath -> FilePath -> IO ParsedModule -parseOneFile libdir fileName = do - let modByFile m = - case ml_hs_file $ ms_location m of - Nothing -> False - Just fn -> fn == fileName - runGhc (Just libdir) $ do - dflags <- getSessionDynFlags - let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream - _ <- setSessionDynFlags dflags2 - addTarget Target { targetId = TargetFile fileName Nothing - , targetAllowObjCode = True - , targetContents = Nothing } - _ <- load LoadAllTargets - graph <- getModuleGraph - let - modSum = case filter modByFile (mgModSummaries graph) of - [x] -> x - xs -> error $ "Can't find module, got:" - ++ show (map (ml_hs_file . ms_location) xs) - parseModule modSum - -getPragmas :: ApiAnns -> String -getPragmas anns = pragmaStr - where - tokComment (L _ (AnnBlockComment s)) = s - tokComment (L _ (AnnLineComment s)) = s - tokComment _ = "" - - comments = case Map.lookup noSrcSpan (snd anns) of - Nothing -> [] - Just cl -> map tokComment $ sortLocated cl - pragmas = filter (\c -> isPrefixOf "{-#" c ) comments - pragmaStr = intercalate "\n" pragmas - -pp :: (Outputable a) => a -> String -pp a = showPpr unsafeGlobalDynFlags a - - diff --git a/utils/check-ppr/README b/utils/check-ppr/README deleted file mode 100644 index f9b502e4a7..0000000000 --- a/utils/check-ppr/README +++ /dev/null @@ -1,26 +0,0 @@ - -This programme is intended to be used by any GHC developers working on the AST -and/or pretty printer by providing a way to check that the same AST is generated -from the pretty printed AST as from the original source. - -i.e., it checks whether - - parse (ppr (parse s)) === parse s - - -This utility is also intended to be used in tests, so that when new features are -added the ability to round-trip the AST via ppr is tested. - -Usage - -In a test Makefile - - $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" FileToParse.hs - -See examples in (REPO_HOME)/testsuite/tests/printer/Makefile - -The utility generates the following files for ToBeTested.hs - - - ToBeTested.ppr.hs : the ppr result - - ToBeTested.hs.ast : the AST of the original source - - ToBeTested.hs.ast.new : the AST of the re-parsed ppr source diff --git a/utils/check-ppr/check-ppr.cabal b/utils/check-ppr/check-ppr.cabal deleted file mode 100644 index 584558b3ff..0000000000 --- a/utils/check-ppr/check-ppr.cabal +++ /dev/null @@ -1,31 +0,0 @@ -Name: check-ppr -Version: 0.1 -Copyright: XXX -License: BSD3 --- XXX License-File: LICENSE -Author: XXX -Maintainer: XXX -Synopsis: A utilities for checking the consistency of GHC's pretty printer -Description: - This utility is used to check the consistency of the GHC pretty printer, by - parsing a file, pretty printing it, and then re-parsing the pretty printed - version. See @utils/check-ppr/README@ in GHC's source distribution for - details. -Category: Development -build-type: Simple -cabal-version: >=1.10 - -Executable check-ppr - Default-Language: Haskell2010 - - Main-Is: Main.hs - - Ghc-Options: -Wall - - Build-Depends: base >= 4 && < 5, - bytestring, - containers, - Cabal >= 2.0 && < 2.1, - directory, - filepath, - ghc diff --git a/utils/check-ppr/ghc.mk b/utils/check-ppr/ghc.mk deleted file mode 100644 index 189b447171..0000000000 --- a/utils/check-ppr/ghc.mk +++ /dev/null @@ -1,18 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (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-ppr_USES_CABAL = YES -utils/check-ppr_PACKAGE = check-ppr -utils/check-ppr_dist-install_PROGNAME = check-ppr -utils/check-ppr_dist-install_INSTALL = NO -utils/check-ppr_dist-install_INSTALL_INPLACE = YES -$(eval $(call build-prog,utils/check-ppr,dist-install,2)) -- cgit v1.2.1