[commit: ghc] master: Warn on missing home modules (15b9a85)
git at git.haskell.org
git at git.haskell.org
Fri Jan 20 22:26:01 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/15b9a85ef03e2729d487a6f8460be8880c797609/ghc
>---------------------------------------------------------------
commit 15b9a85ef03e2729d487a6f8460be8880c797609
Author: Yuras Shumovich <shumovichy at gmail.com>
Date: Fri Jan 20 16:53:45 2017 -0500
Warn on missing home modules
Introduce a warning, -Wmissing-home-modules, to warn about home modules,
not listed in command line.
It is usefull for cabal when user fails to list a module in
`exposed-modules` and `other-modules`.
Test Plan: make TEST=MissingMod
Reviewers: mpickering, austin, bgamari
Reviewed By: bgamari
Subscribers: simonpj, mpickering, thomie
Differential Revision: https://phabricator.haskell.org/D2977
GHC Trac Issues: #13129
>---------------------------------------------------------------
15b9a85ef03e2729d487a6f8460be8880c797609
compiler/main/DynFlags.hs | 2 ++
compiler/main/GhcMake.hs | 39 ++++++++++++++++++++++
docs/users_guide/using-warnings.rst | 13 +++++++-
.../tests/warnings/should_compile/MissingMod.hs | 4 +++
.../warnings/should_compile/MissingMod.stderr | 5 +++
.../tests/warnings/should_compile/MissingMod1.hs | 2 ++
testsuite/tests/warnings/should_compile/all.T | 2 ++
utils/mkUserGuidePart/Options/Warnings.hs | 9 +++++
8 files changed, 75 insertions(+), 1 deletion(-)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index bcd5a25..6dbd723 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -636,6 +636,7 @@ data WarningFlag =
| Opt_WarnSimplifiableClassConstraints -- Since 8.2
| Opt_WarnCPPUndef -- Since 8.2
| Opt_WarnUnbangedStrictPatterns -- Since 8.2
+ | Opt_WarnMissingHomeModules -- Since 8.2
deriving (Eq, Show, Enum)
data Language = Haskell98 | Haskell2010
@@ -3443,6 +3444,7 @@ wWarningFlagsDeps = [
flagSpec "missing-pattern-synonym-signatures"
Opt_WarnMissingPatternSynonymSignatures,
flagSpec "simplifiable-class-constraints" Opt_WarnSimplifiableClassConstraints,
+ flagSpec "missing-home-modules" Opt_WarnMissingHomeModules,
flagSpec "unrecognised-warning-flags" Opt_WarnUnrecognisedWarningFlags ]
-- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index be6510b..f74d097 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -132,9 +132,48 @@ depanal excluded_mods allow_dup_roots = do
mod_graphE <- liftIO $ downsweep hsc_env old_graph
excluded_mods allow_dup_roots
mod_graph <- reportImportErrors mod_graphE
+
+ warnMissingHomeModules hsc_env mod_graph
+
setSession hsc_env { hsc_mod_graph = mod_graph }
return mod_graph
+-- Note [Missing home modules]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Sometimes user doesn't want GHC to pick up modules, not explicitly listed
+-- in a command line. For example, cabal may want to enable this warning
+-- when building a library, so that GHC warns user about modules, not listed
+-- neither in `exposed-modules`, nor in `other-modules`.
+--
+-- Here "home module" means a module, that doesn't come from an other package.
+--
+-- For example, if GHC is invoked with modules "A" and "B" as targets,
+-- but "A" imports some other module "C", then GHC will issue a warning
+-- about module "C" not being listed in a command line.
+--
+-- The warning in enabled by `-Wmissing-home-modules`. See Trac #13129
+warnMissingHomeModules :: GhcMonad m => HscEnv -> ModuleGraph -> m ()
+warnMissingHomeModules hsc_env mod_graph =
+ when (wopt Opt_WarnMissingHomeModules dflags && not (null missing)) $
+ logWarnings (listToBag [warn])
+ where
+ dflags = hsc_dflags hsc_env
+ missing = filter (`notElem` targets) imports
+ imports = map (moduleName . ms_mod) mod_graph
+ targets = map (targetid_to_name . targetId) (hsc_targets hsc_env)
+
+ msg = text "Modules are not listed in command line: "
+ <> sep (map ppr missing)
+ warn = makeIntoWarning
+ (Reason Opt_WarnMissingHomeModules)
+ (mkPlainErrMsg dflags noSrcSpan msg)
+
+ targetid_to_name (TargetModule name) = name
+ targetid_to_name (TargetFile file _) =
+ -- We can get a file even if module name in specified in command line
+ -- because it can be converted in guessTarget. So lets convert it back.
+ mkModuleName (fst $ splitExtension file)
+
-- | Describes which modules of the module graph need to be loaded.
data LoadHowMuch
= LoadAllTargets
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 21f00c4..de660ed 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -66,6 +66,7 @@ The following flags are simple ways to select standard "packages" of warnings:
* :ghc-flag:`-Wmissing-local-signatures`
* :ghc-flag:`-Wmissing-exported-signatures`
* :ghc-flag:`-Wmissing-import-lists`
+ * :ghc-flag:`-Wmissing-home-modules`
* :ghc-flag:`-Widentities`
.. ghc-flag:: -Wcompat
@@ -1035,7 +1036,17 @@ of ``-W(no-)*``.
This flag warns whenever you write a pattern that binds a variable whose
type is unlifted, and yet the pattern is not a bang pattern nor a bare variable.
- See :ref:`glasgow-unboxed` for informatino about unlifted types.
+ See :ref:`glasgow-unboxed` for information about unlifted types.
+
+.. ghc-flag:: -Wmissing-home-modules
+
+ :since: 8.2
+
+ When a module provided by the package currently being compiled
+ (i.e. the "home" package) is imported, but not explicitly listed in
+ command line as a target. Useful for Cabal to ensure GHC won't
+ pick up modules, not listed neither in ``exposed-modules``, nor in
+ ``other-modules``.
If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice.
It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's
diff --git a/testsuite/tests/warnings/should_compile/MissingMod.hs b/testsuite/tests/warnings/should_compile/MissingMod.hs
new file mode 100644
index 0000000..eaf7983
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/MissingMod.hs
@@ -0,0 +1,4 @@
+module MissingMod
+where
+
+import MissingMod1
diff --git a/testsuite/tests/warnings/should_compile/MissingMod.stderr b/testsuite/tests/warnings/should_compile/MissingMod.stderr
new file mode 100644
index 0000000..0045092
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/MissingMod.stderr
@@ -0,0 +1,5 @@
+
+<no location info>: warning: [-Wmissing-home-modules]
+ Modules are not listed in command line: MissingMod1
+[1 of 2] Compiling MissingMod1 ( MissingMod1.hs, MissingMod1.o )
+[2 of 2] Compiling MissingMod ( MissingMod.hs, MissingMod.o )
diff --git a/testsuite/tests/warnings/should_compile/MissingMod1.hs b/testsuite/tests/warnings/should_compile/MissingMod1.hs
new file mode 100644
index 0000000..2e78c23
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/MissingMod1.hs
@@ -0,0 +1,2 @@
+module MissingMod1
+where
diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T
index bb347b0..f7f0194 100644
--- a/testsuite/tests/warnings/should_compile/all.T
+++ b/testsuite/tests/warnings/should_compile/all.T
@@ -24,3 +24,5 @@ test('DeprU',
test('Werror01', normal, compile, [''])
test('Werror02', normal, compile, [''])
+
+test('MissingMod', normal, multimod_compile, ['MissingMod', '-Wmissing-home-modules'])
diff --git a/utils/mkUserGuidePart/Options/Warnings.hs b/utils/mkUserGuidePart/Options/Warnings.hs
index f18222e..f242fb0 100644
--- a/utils/mkUserGuidePart/Options/Warnings.hs
+++ b/utils/mkUserGuidePart/Options/Warnings.hs
@@ -445,4 +445,13 @@ warningsOptions =
, flagType = DynamicFlag
, flagReverse = "-Wno-deriving-typeable"
}
+ , flag { flagName = "-Wmissing-home-modules"
+ , flagDescription =
+ "warn when encountering a home module imported, but not listed "++
+ "on the command line. Useful for cabal to ensure GHC won't pick "++
+ "up modules, not listed neither in ``exposed-modules``, nor in "++
+ "``other-modules``."
+ , flagType = DynamicFlag
+ , flagReverse = "-Wno-missing-home-modules"
+ }
]
More information about the ghc-commits
mailing list