summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ghc.mk3
-rw-r--r--hadrian/src/Packages.hs5
-rw-r--r--hadrian/src/Rules/BinaryDist.hs2
-rw-r--r--hadrian/src/Rules/Test.hs11
-rw-r--r--hadrian/src/Settings/Builders/Make.hs2
-rw-r--r--hadrian/src/Settings/Default.hs2
-rw-r--r--testsuite/mk/boilerplate.mk5
-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/Makefile23
-rw-r--r--testsuite/tests/count-deps/all.T2
-rw-r--r--testsuite/tests/parser/should_run/CountAstDeps.hs16
-rw-r--r--testsuite/tests/parser/should_run/CountParserDeps.hs16
-rw-r--r--testsuite/tests/parser/should_run/all.T8
-rw-r--r--utils/count-deps/Main.hs (renamed from testsuite/tests/parser/should_run/CountDeps.hs)45
-rw-r--r--utils/count-deps/README.md43
-rw-r--r--utils/count-deps/count-deps.cabal24
-rw-r--r--utils/count-deps/ghc.mk18
18 files changed, 161 insertions, 64 deletions
diff --git a/ghc.mk b/ghc.mk
index 070ddfe45b..a244c1b53c 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -569,6 +569,7 @@ ghc/stage2/package-data.mk: compiler/stage2/package-data.mk
utils/haddock/dist/package-data.mk: compiler/stage2/package-data.mk
utils/check-ppr/dist-install/package-data.mk: compiler/stage2/package-data.mk
utils/check-exact/dist-install/package-data.mk: compiler/stage2/package-data.mk
+utils/count-deps/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
@@ -667,6 +668,7 @@ BUILD_DIRS += utils/ghc-pkg
BUILD_DIRS += utils/testremove
BUILD_DIRS += utils/check-ppr
BUILD_DIRS += utils/check-exact
+BUILD_DIRS += utils/count-deps
BUILD_DIRS += utils/ghc-cabal
BUILD_DIRS += utils/hpc
BUILD_DIRS += utils/runghc
@@ -709,6 +711,7 @@ ifneq "$(CrossCompiling) $(Stage1Only)" "NO NO"
# See Note [Stage1Only vs stage=1] in mk/config.mk.in.
BUILD_DIRS := $(filter-out utils/check-ppr,$(BUILD_DIRS))
BUILD_DIRS := $(filter-out utils/check-exact,$(BUILD_DIRS))
+BUILD_DIRS := $(filter-out utils/count-deps,$(BUILD_DIRS))
endif
endif # CLEANING
diff --git a/hadrian/src/Packages.hs b/hadrian/src/Packages.hs
index c56feae796..f75236cd9a 100644
--- a/hadrian/src/Packages.hs
+++ b/hadrian/src/Packages.hs
@@ -2,7 +2,7 @@
module Packages (
-- * GHC packages
array, base, binary, bytestring, cabal, checkPpr,
- checkExact,
+ checkExact, countDeps,
compareSizes, compiler, containers, deepseq, deriveConstants, directory,
exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh,
ghcCompact, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline,
@@ -32,7 +32,7 @@ import Oracles.Setting
-- packages and modify build default build conditions in "UserSettings".
ghcPackages :: [Package]
ghcPackages =
- [ array, base, binary, bytestring, cabal, checkPpr, checkExact
+ [ array, base, binary, bytestring, cabal, checkPpr, checkExact, countDeps
, compareSizes, compiler, containers, deepseq, deriveConstants, directory
, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh
, ghcCompact, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs
@@ -53,6 +53,7 @@ bytestring = lib "bytestring"
cabal = lib "Cabal" `setPath` "libraries/Cabal/Cabal"
checkPpr = util "check-ppr"
checkExact = util "check-exact"
+countDeps = util "count-deps"
compareSizes = util "compareSizes" `setPath` "utils/compare_sizes"
compiler = top "ghc" `setPath` "compiler"
containers = lib "containers" `setPath` "libraries/containers/containers"
diff --git a/hadrian/src/Rules/BinaryDist.hs b/hadrian/src/Rules/BinaryDist.hs
index 2c90b3fe5c..75178e2fef 100644
--- a/hadrian/src/Rules/BinaryDist.hs
+++ b/hadrian/src/Rules/BinaryDist.hs
@@ -172,7 +172,7 @@ bindistRules = do
need $ map (bindistFilesDir -/-)
(["configure", "Makefile"] ++ bindistInstallFiles)
need $ map ((bindistFilesDir -/- "wrappers") -/-)
- [ "check-ppr", "check-exact", "ghc", "ghc-iserv", "ghc-pkg"
+ [ "check-ppr", "check-exact", "count-deps", "ghc", "ghc-iserv", "ghc-pkg"
, "ghci-script", "haddock", "hpc", "hp2ps", "hsc2hs"
, "runghc"]
diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs
index 495ec3b7cb..ff986f879e 100644
--- a/hadrian/src/Rules/Test.hs
+++ b/hadrian/src/Rules/Test.hs
@@ -37,11 +37,17 @@ checkExactSourcePath = "utils/check-exact/Main.hs"
checkExactExtra :: Maybe String
checkExactExtra = Just "-iutils/check-exact"
+countDepsProgPath, countDepsSourcePath :: FilePath
+countDepsProgPath = "test/bin/count-deps" <.> exe
+countDepsSourcePath = "utils/count-deps/Main.hs"
+countDepsExtra :: Maybe String
+countDepsExtra = Just "-iutils/count-deps"
checkPrograms :: [(FilePath, FilePath, Maybe String, Package)]
checkPrograms =
[ (checkPprProgPath, checkPprSourcePath, checkPprExtra, checkPpr)
, (checkExactProgPath, checkExactSourcePath, checkExactExtra, checkExact)
+ , (countDepsProgPath, countDepsSourcePath, countDepsExtra, countDeps)
]
ghcConfigPath :: FilePath
@@ -132,7 +138,9 @@ testRules = do
pythonPath <- builderPath Python
need [ root -/- checkPprProgPath
- , root -/- checkExactProgPath ]
+ , root -/- checkExactProgPath
+ , root -/- countDepsProgPath
+ ]
-- Set environment variables for test's Makefile.
-- TODO: Ideally we would define all those env vars in 'env', so that
@@ -149,6 +157,7 @@ testRules = do
setEnv "TEST_HC_OPTS_INTERACTIVE" ghciFlags
setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath)
setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath)
+ setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath)
-- This lets us bypass the need to generate a config
-- through Make, which happens in testsuite/mk/boilerplate.mk
diff --git a/hadrian/src/Settings/Builders/Make.hs b/hadrian/src/Settings/Builders/Make.hs
index 9efea20275..f00aab9776 100644
--- a/hadrian/src/Settings/Builders/Make.hs
+++ b/hadrian/src/Settings/Builders/Make.hs
@@ -26,12 +26,14 @@ validateBuilderArgs = builder (Make "testsuite/tests") ? do
compiler <- expr $ fullpath ghc
checkPpr <- expr $ fullpath checkPpr
checkExact <- expr $ fullpath checkExact
+ countDeps <- expr $ fullpath countDeps
args <- expr $ userSetting defaultTestArgs
return [ setTestSpeed $ testSpeed args
, "THREADS=" ++ show threads
, "TEST_HC=" ++ (top -/- compiler)
, "CHECK_PPR=" ++ (top -/- checkPpr)
, "CHECK_EXACT=" ++ (top -/- checkExact)
+ , "COUNT_DEPS=" ++ (top -/- countDeps)
]
where
fullpath :: Package -> Action FilePath
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index 1a28e1ca72..2da096efdb 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -135,7 +135,7 @@ stage2Packages = stage1Packages
-- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package]
-testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact ])
+testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps ])
-- | Default build ways for library packages:
-- * We always build 'vanilla' way.
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/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, [''])
diff --git a/testsuite/tests/parser/should_run/CountDeps.hs b/utils/count-deps/Main.hs
index fab36de4a8..2ce6ea9f5b 100644
--- a/testsuite/tests/parser/should_run/CountDeps.hs
+++ b/utils/count-deps/Main.hs
@@ -1,19 +1,29 @@
-module CountDeps (printDeps) where
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+
+module Main 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
+-- Example invocation:
+-- inplace/bin/count-deps `inplace/bin/ghc-stage2 --print-libdir` "GHC.Parser"
+main :: IO ()
+main = do
+ args <- getArgs
+ case args of
+ [libdir, modName, "--dot"] -> printDeps libdir modName True
+ [libdir, modName] -> printDeps libdir modName False
+ _ -> fail "usage: count-deps libdir module [--dot]"
+
dotSpec :: String -> Map.Map String [String] -> String
dotSpec name g =
"digraph \"" ++ name ++ "\" {\n" ++
@@ -21,23 +31,22 @@ dotSpec name g =
where
f acc k ns = acc ++ concat [" " ++ show k ++ " -> " ++ show n ++ ";\n" | n <- ns]
-printDeps :: String -> IO ()
-printDeps modName = do
- [libdir] <- getArgs
+printDeps :: String -> String -> Bool -> IO ()
+printDeps libdir modName dot = do
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'
+ if not dot then
+ do
+ let modules = Map.keys modGraph
+ num = length modules
+ putStrLn $ "Found " ++ show num ++ " " ++ modName ++ " module dependencies"
+ forM_ modules putStrLn
+ else
+ -- * 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'
+ putStr $ dotSpec modName modGraph
calcDeps :: String -> FilePath -> IO (Map.Map ModuleName [ModuleName])
calcDeps modName libdir =
diff --git a/utils/count-deps/README.md b/utils/count-deps/README.md
new file mode 100644
index 0000000000..67d8ed4842
--- /dev/null
+++ b/utils/count-deps/README.md
@@ -0,0 +1,43 @@
+# README
+
+The `count-deps` executable is used in the test-suite to detect when
+the number of dependencies of certain modules change ([this blog
+post](https://blog.shaynefletcher.org/2020/10/ghc-lib-parser-module-count.html)
+gives one example of where and why this can be useful).
+
+More generally it's useful for obtaining insight into a modules'
+dependency graph. As used in the tests it produces (1) a count of a
+modules' dependencies together with the list of depended upon modules
+. However, it can also (2), print a modules' dependency graph in dot
+language syntax suitable for rendering with "graphviz" (open source
+graph visualization software).
+
+## Installing graphviz
+
+To render graphs generated by `count-deps`, first visit [the graphviz
+downloads page](https://graphviz.org/download/) to download and
+install graphviz on your system.
+
+## `count-deps` usage examples:
+
+ - `make`:
+
+ (1) ``inplace/bin/count-deps `inplace/bin/ghc-stage2 --print-libdir` "GHC.Parser"``
+ (2) ``inplace/bin/count-deps `inplace/bin/ghc-stage2 --print-libdir` "GHC.Parser" --dot``
+
+ - `hadrian`:
+ (1) ``_build/stage1/bin/count-deps `_build/stage1/bin/ghc --print-libdir` "GHC.Parser"``
+ (2) ``_build/stage1/bin/count-deps `_build/stage1/bin/ghc --print-libdir` "GHC.Parser" --dot``
+
+## Rendering dependency graphs
+
+To render a graph obtained using a type (2) command:
+
+ - Copy the output to a file ('`deps.dot`' say)
+
+ - Render it with a command like (preprocess with `tred` to remove
+ edges implied by transitivity)
+
+ ```bash
+ tred deps.dot > deps-tred.dot&& dot -Tpdf -o deps.pdf deps-tred.dot
+ ```
diff --git a/utils/count-deps/count-deps.cabal b/utils/count-deps/count-deps.cabal
new file mode 100644
index 0000000000..38a7621aaa
--- /dev/null
+++ b/utils/count-deps/count-deps.cabal
@@ -0,0 +1,24 @@
+Name: count-deps
+Version: 0.1
+Copyright: XXX
+License: BSD3
+-- XXX License-File: LICENSE
+Author: XXX
+Maintainer: XXX
+Synopsis: A utilities for analyzing module dependencies
+Description:
+ This utility is used inspect the dependencies of a module
+ @utils/count-deps/README@ in GHC's source distribution for
+ details.
+Category: Development
+build-type: Simple
+cabal-version: >=1.10
+
+Executable count-deps
+ Default-Language: Haskell2010
+ Main-Is: Main.hs
+ Ghc-Options: -Wall
+ other-modules:
+ Build-Depends: base >= 4 && < 5,
+ containers,
+ ghc
diff --git a/utils/count-deps/ghc.mk b/utils/count-deps/ghc.mk
new file mode 100644
index 0000000000..45259efee6
--- /dev/null
+++ b/utils/count-deps/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
+# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture
+# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying
+#
+# -----------------------------------------------------------------------------
+
+utils/count-deps_USES_CABAL = YES
+utils/count-deps_PACKAGE = count-deps
+utils/count-deps_dist-install_PROGNAME = count-deps
+utils/count-deps_dist-install_INSTALL = NO
+utils/count-deps_dist-install_INSTALL_INPLACE = YES
+$(eval $(call build-prog,utils/count-deps,dist-install,2))