diff options
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/mk/boilerplate.mk | 5 | ||||
-rw-r--r-- | testsuite/tests/count-deps/CountDepsAst.stdout (renamed from testsuite/tests/parser/should_run/CountAstDeps.stdout) | 0 | ||||
-rw-r--r-- | testsuite/tests/count-deps/CountDepsParser.stdout (renamed from testsuite/tests/parser/should_run/CountParserDeps.stdout) | 0 | ||||
-rw-r--r-- | testsuite/tests/count-deps/Makefile | 23 | ||||
-rw-r--r-- | testsuite/tests/count-deps/all.T | 2 | ||||
-rw-r--r-- | testsuite/tests/parser/should_run/CountAstDeps.hs | 16 | ||||
-rw-r--r-- | testsuite/tests/parser/should_run/CountDeps.hs | 71 | ||||
-rw-r--r-- | testsuite/tests/parser/should_run/CountParserDeps.hs | 16 | ||||
-rw-r--r-- | testsuite/tests/parser/should_run/all.T | 8 |
9 files changed, 29 insertions, 112 deletions
diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk index a2fb56d1ba..942e6e32c2 100644 --- a/testsuite/mk/boilerplate.mk +++ b/testsuite/mk/boilerplate.mk @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(COUNT_DEPS)" "" +COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) +endif + # ----------------------------------------------------------------------------- # configuration of TEST_HC @@ -296,4 +300,3 @@ FREEBSD = YES else FREEBSD = NO endif - diff --git a/testsuite/tests/parser/should_run/CountAstDeps.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout index 4b33ad2982..4b33ad2982 100644 --- a/testsuite/tests/parser/should_run/CountAstDeps.stdout +++ b/testsuite/tests/count-deps/CountDepsAst.stdout diff --git a/testsuite/tests/parser/should_run/CountParserDeps.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout index 16dbb8e185..16dbb8e185 100644 --- a/testsuite/tests/parser/should_run/CountParserDeps.stdout +++ b/testsuite/tests/count-deps/CountDepsParser.stdout diff --git a/testsuite/tests/count-deps/Makefile b/testsuite/tests/count-deps/Makefile new file mode 100644 index 0000000000..41911c47df --- /dev/null +++ b/testsuite/tests/count-deps/Makefile @@ -0,0 +1,23 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +LIBDIR := "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +# Calculate the number of module dependencies of 'Parser.' If that +# number exceeds a threshold, that indicates that the dependencies +# have significantly gone up via the commit under test (and the test +# is deemed to fail). In that case, this most likely means a cycle +# has arisen that pulls in modules for Core generation. The +# motivation for not allowing that to happen is so that the +# 'ghc-lib-parser' package subset of the GHC API can continue to be +# provided with as small a number of modules as possible for when the +# need exists to produce ASTs and nothing more. + +.PHONY: count-deps-parser +count-deps-parser: + $(COUNT_DEPS) $(LIBDIR) "GHC.Parser" + +.PHONY: count-deps-ast +count-deps-ast: + $(COUNT_DEPS) $(LIBDIR) "Language.Haskell.Syntax" diff --git a/testsuite/tests/count-deps/all.T b/testsuite/tests/count-deps/all.T new file mode 100644 index 0000000000..6b8abd9c95 --- /dev/null +++ b/testsuite/tests/count-deps/all.T @@ -0,0 +1,2 @@ +test('CountDepsAst', [], makefile_test, ['count-deps-ast']) +test('CountDepsParser', [], makefile_test, ['count-deps-parser']) diff --git a/testsuite/tests/parser/should_run/CountAstDeps.hs b/testsuite/tests/parser/should_run/CountAstDeps.hs deleted file mode 100644 index ba7f0c50f9..0000000000 --- a/testsuite/tests/parser/should_run/CountAstDeps.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Main(main) where - --- Calculate the number of module dependencies of 'Parser.' If that --- number exceeds a threshold, that indicates that the dependencies --- have significantly gone up via the commit under test (and the test --- is deemed to fail). In that case, this most likely means a cycle --- has arisen that pulls in modules for Core generation. The --- motivation for not allowing that to happen is so that the --- 'ghc-lib-parser' package subset of the GHC API can continue to be --- provided with as small a number of modules as possible for when the --- need exists to produce ASTs and nothing more. - -import CountDeps - -main :: IO () -main = printDeps "Language.Haskell.Syntax" diff --git a/testsuite/tests/parser/should_run/CountDeps.hs b/testsuite/tests/parser/should_run/CountDeps.hs deleted file mode 100644 index fab36de4a8..0000000000 --- a/testsuite/tests/parser/should_run/CountDeps.hs +++ /dev/null @@ -1,71 +0,0 @@ -module CountDeps (printDeps) where - -import GHC.Driver.Env -import GHC.Unit.Module -import GHC.Driver.Session -import GHC.Driver.Main -import GHC -import GHC.Utils.Misc -import Data.Maybe -import Control.Monad -import Control.Monad.IO.Class -import System.Environment -import System.Exit -import GHC.Unit.Module.Deps -import Data.Map.Strict qualified as Map - -dotSpec :: String -> Map.Map String [String] -> String -dotSpec name g = - "digraph \"" ++ name ++ "\" {\n" ++ - Map.foldlWithKey' f "" g ++ "}\n" - where - f acc k ns = acc ++ concat [" " ++ show k ++ " -> " ++ show n ++ ";\n" | n <- ns] - -printDeps :: String -> IO () -printDeps modName = do - [libdir] <- getArgs - modGraph <- - Map.map (map moduleNameString) . - Map.mapKeys moduleNameString <$> calcDeps modName libdir - let modules = Map.keys modGraph - num = length modules - putStrLn $ "Found " ++ show num ++ " " ++ modName ++ " module dependencies" - forM_ modules putStrLn - -- Uncomment the next line to print a dependency graph in dot - -- format: - -- putStr $ dotSpec modName modGraph - -- Then, - -- * Copy the digraph output to a file ('deps.dot' say) - -- * To render it, use a command along the lines of - -- 'tred deps.dot > deps-tred.dot && dot -Tpdf -o deps.pdf deps-tred.dot' - -calcDeps :: String -> FilePath -> IO (Map.Map ModuleName [ModuleName]) -calcDeps modName libdir = - defaultErrorHandler defaultFatalMessager defaultFlushOut $ do - runGhc (Just libdir) $ do - df <- getSessionDynFlags - logger <- getLogger - (df, _, _) <- parseDynamicFlags logger df [noLoc "-package=ghc"] - setSessionDynFlags df - env <- getSession - loop env Map.empty [mkModuleName modName] - where - -- Source imports are only guaranteed to show up in the 'mi_deps' - -- of modules that import them directly and don’t propagate - -- transitively so we loop. - loop :: HscEnv -> Map.Map ModuleName [ModuleName] -> [ModuleName] -> Ghc (Map.Map ModuleName [ModuleName]) - loop env modules (m : ms) = - if m `Map.member` modules - then loop env modules ms - else do - mi <- liftIO $ hscGetModuleInterface env (mkModule m) - let deps = modDeps mi - modules <- return $ Map.insert m [] modules - loop env (Map.insert m deps modules) $ ms ++ filter (not . (`Map.member` modules)) deps - loop _ modules [] = return modules - - mkModule :: ModuleName -> Module - mkModule = Module (stringToUnit "ghc") - - modDeps :: ModIface -> [ModuleName] - modDeps mi = map gwib_mod $ dep_direct_mods (mi_deps mi) diff --git a/testsuite/tests/parser/should_run/CountParserDeps.hs b/testsuite/tests/parser/should_run/CountParserDeps.hs deleted file mode 100644 index f1dacb1d62..0000000000 --- a/testsuite/tests/parser/should_run/CountParserDeps.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Main(main) where - --- Calculate the number of module dependencies of 'Parser.' If that --- number exceeds a threshold, that indicates that the dependencies --- have significantly gone up via the commit under test (and the test --- is deemed to fail). In that case, this most likely means a cycle --- has arisen that pulls in modules for Core generation. The --- motivation for not allowing that to happen is so that the --- 'ghc-lib-parser' package subset of the GHC API can continue to be --- provided with as small a number of modules as possible for when the --- need exists to produce ASTs and nothing more. - -import CountDeps - -main :: IO () -main = printDeps "GHC.Parser" diff --git a/testsuite/tests/parser/should_run/all.T b/testsuite/tests/parser/should_run/all.T index 5c2112057e..92c6d0fcb3 100644 --- a/testsuite/tests/parser/should_run/all.T +++ b/testsuite/tests/parser/should_run/all.T @@ -14,14 +14,6 @@ test('NegativeZero', normal, compile_and_run, ['']) test('HexFloatLiterals', normal, compile_and_run, ['']) test('NumericUnderscores0', normal, compile_and_run, ['']) test('NumericUnderscores1', normal, compile_and_run, ['']) -test('CountAstDeps', - [ extra_files(['CountDeps.hs']), only_ways(['normal']), extra_run_opts('"' + config.libdir + '"') ], - compile_and_run, - ['-package ghc']) -test('CountParserDeps', - [ extra_files(['CountDeps.hs']), only_ways(['normal']), extra_run_opts('"' + config.libdir + '"') ], - compile_and_run, - ['-package ghc']) test('LexNegLit', normal, compile_and_run, ['']) test('RecordDotSyntax1', normal, compile_and_run, ['']) test('RecordDotSyntax2', normal, compile_and_run, ['']) |