diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-07-06 12:08:08 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-07-13 15:16:19 -0400 |
commit | aef7d51350feebfb29a011361d03b249049a2a0b (patch) | |
tree | 3eb11cf34b63bedb0323bee82da49590b00a5a45 | |
parent | a181313e9205fe289bedf6c8931eb2933490625c (diff) | |
download | haskell-aef7d51350feebfb29a011361d03b249049a2a0b.tar.gz |
driver: Fix interaction of -Wunused-packages and reexported-modules
Spurious warnings were previously emitted if an import came from a
reexport due to how -Wunused-packages were implemented. Removing the
dependency would cause compilation to fail.
The fix is to reimplement the warning a bit more directly, by searching
for which package each import comes from using the normal module finding
functions rather than consulting the EPS. This has the advantage that
the check could be performed at any time after downsweep rather than
also relying on a populated EPS.
Fixes #19518 and #19777
-rw-r--r-- | compiler/GHC/Driver/Make.hs | 24 | ||||
-rw-r--r-- | compiler/GHC/Unit/Finder.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Unit/State.hs | 28 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/Makefile | 44 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/Setup.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/all.T | 9 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/p/LICENSE | 0 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/p/P.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/p/P2.hs | 1 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/p/Setup.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/p/p.cabal | 11 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/q/LICENSE | 0 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/q/Q.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/q/Setup.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/q/q.cabal | 12 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/r/LICENSE | 0 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/r/R.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/r/Setup.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/cabal/t19518/r/r.cabal | 11 |
19 files changed, 142 insertions, 18 deletions
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index 46bb160cfc..2f03bcebd7 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -103,7 +103,6 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Unit -import GHC.Unit.External import GHC.Unit.Finder import GHC.Unit.Module.ModSummary import GHC.Unit.Module.ModIface @@ -125,7 +124,7 @@ import Control.Monad import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE ) import qualified Control.Monad.Catch as MC import Data.IORef -import Data.List (nub, sort, sortBy, partition) +import Data.List (sortBy, partition) import qualified Data.List as List import Data.Foldable (toList) import Data.Maybe @@ -339,7 +338,7 @@ load :: GhcMonad m => LoadHowMuch -> m SuccessFlag load how_much = do (errs, mod_graph) <- depanalE [] False -- #17459 success <- load' how_much (Just batchMsg) mod_graph - warnUnusedPackages + warnUnusedPackages mod_graph if isEmptyMessages errs then pure success else throwErrors (fmap GhcDriverMessage errs) @@ -351,24 +350,21 @@ load how_much = do -- actually loaded packages. All the packages, specified on command line, -- but never loaded, are probably unused dependencies. -warnUnusedPackages :: GhcMonad m => m () -warnUnusedPackages = do +warnUnusedPackages :: GhcMonad m => ModuleGraph -> m () +warnUnusedPackages mod_graph = do hsc_env <- getSession - eps <- liftIO $ hscEPS hsc_env let dflags = hsc_dflags hsc_env state = hsc_units hsc_env - pit = eps_PIT eps diag_opts = initDiagOpts dflags + us = hsc_units hsc_env - let loadedPackages - = map (unsafeLookupUnit state) - . nub . sort - . map moduleUnit - . moduleEnvKeys - $ pit + -- Only need non-source imports here because SOURCE imports are always HPT + let loadedPackages = concat $ + mapMaybe (\(fs, mn) -> lookupModulePackage us (unLoc mn) fs) + $ concatMap ms_imps (mgModSummaries mod_graph) - requestedArgs = mapMaybe packageArg (packageFlags dflags) + let requestedArgs = mapMaybe packageArg (packageFlags dflags) unusedArgs = filter (\arg -> not $ any (matching state arg) loadedPackages) diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs index 57e458af79..a99c4b68c0 100644 --- a/compiler/GHC/Unit/Finder.hs +++ b/compiler/GHC/Unit/Finder.hs @@ -227,7 +227,7 @@ findLookupResult :: FinderCache -> DynFlags -> LookupResult -> IO FindResult findLookupResult fc dflags r = case r of LookupFound m pkg_conf -> do let im = fst (getModuleInstantiation m) - r' <- findPackageModule_ fc dflags im pkg_conf + r' <- findPackageModule_ fc dflags im (fst pkg_conf) case r' of -- TODO: ghc -M is unlikely to do the right thing -- with just the location of the thing that was diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs index 32e35161b2..c178be88aa 100644 --- a/compiler/GHC/Unit/State.hs +++ b/compiler/GHC/Unit/State.hs @@ -2,6 +2,7 @@ {-# LANGUAGE ScopedTypeVariables, BangPatterns, FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} -- | Unit manipulation module GHC.Unit.State ( @@ -34,6 +35,7 @@ module GHC.Unit.State ( listVisibleModuleNames, lookupModuleInAllUnits, lookupModuleWithSuggestions, + lookupModulePackage, lookupPluginModuleWithSuggestions, requirementMerges, LookupResult(..), @@ -1790,7 +1792,7 @@ lookupModuleInAllUnits :: UnitState -> [(Module, UnitInfo)] lookupModuleInAllUnits pkgs m = case lookupModuleWithSuggestions pkgs m Nothing of - LookupFound a b -> [(a,b)] + LookupFound a b -> [(a,fst b)] LookupMultiple rs -> map f rs where f (m,_) = (m, expectJust "lookupModule" (lookupUnit pkgs (moduleUnit m))) @@ -1799,7 +1801,7 @@ lookupModuleInAllUnits pkgs m -- | The result of performing a lookup data LookupResult = -- | Found the module uniquely, nothing else to do - LookupFound Module UnitInfo + LookupFound Module (UnitInfo, ModuleOrigin) -- | Multiple modules with the same name in scope | LookupMultiple [(Module, ModuleOrigin)] -- | No modules found, but there were some hidden ones with @@ -1822,6 +1824,26 @@ lookupModuleWithSuggestions :: UnitState lookupModuleWithSuggestions pkgs = lookupModuleWithSuggestions' pkgs (moduleNameProvidersMap pkgs) +-- | The package which the module **appears** to come from, this could be +-- the one which reexports the module from it's original package. This function +-- is currently only used for -Wunused-packages +lookupModulePackage :: UnitState -> ModuleName -> Maybe FastString -> Maybe [UnitInfo] +lookupModulePackage pkgs mn mfs = + case lookupModuleWithSuggestions' pkgs (moduleNameProvidersMap pkgs) mn mfs of + LookupFound _ (orig_unit, origin) -> + case origin of + ModOrigin {fromOrigUnit, fromExposedReexport} -> + case fromOrigUnit of + -- Just True means, the import is available from its original location + Just True -> + pure [orig_unit] + -- Otherwise, it must be available from a reexport + _ -> pure fromExposedReexport + + _ -> Nothing + + _ -> Nothing + lookupPluginModuleWithSuggestions :: UnitState -> ModuleName -> Maybe FastString @@ -1840,7 +1862,7 @@ lookupModuleWithSuggestions' pkgs mod_map m mb_pn Just xs -> case foldl' classify ([],[],[], []) (Map.toList xs) of ([], [], [], []) -> LookupNotFound suggestions - (_, _, _, [(m, _)]) -> LookupFound m (mod_unit m) + (_, _, _, [(m, o)]) -> LookupFound m (mod_unit m, o) (_, _, _, exposed@(_:_)) -> LookupMultiple exposed ([], [], unusable@(_:_), []) -> LookupUnusable unusable (hidden_pkg, hidden_mod, _, []) -> diff --git a/testsuite/tests/cabal/t19518/Makefile b/testsuite/tests/cabal/t19518/Makefile new file mode 100644 index 0000000000..e5a282e13f --- /dev/null +++ b/testsuite/tests/cabal/t19518/Makefile @@ -0,0 +1,44 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP = ../Setup -v0 + +# This test is for package reexports and -Wunused-packages working together +# 1. install p +# 2. install q (reexporting p modules) +# 3. install r (using reexports from q) +# +# When building r, it should not suggest the import of q package is redundant + +t19518: clean + $(MAKE) -s --no-print-directory clean + '$(GHC_PKG)' init tmp.d + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup + # build p + cd p && $(SETUP) clean + cd p && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/$$pkgid' + cd p && $(SETUP) build + cd p && $(SETUP) copy + cd p && $(SETUP) register + # build q + cd q && $(SETUP) clean + cd q && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/$$pkgid' + cd q && $(SETUP) build + cd q && $(SETUP) copy + cd q && $(SETUP) register + # build r + cd r && $(SETUP) clean + cd r && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS) -Wunused-packages' --package-db=../tmp.d --prefix='$(PWD)/$$pkgid' + cd r && $(SETUP) build + cd r && $(SETUP) copy + cd r && $(SETUP) register +ifneq "$(CLEANUP)" "" + $(MAKE) -s --no-print-directory clean +endif + +clean : + '$(GHC_PKG)' unregister --force p >/dev/null 2>&1 || true + '$(GHC_PKG)' unregister --force q >/dev/null 2>&1 || true + '$(GHC_PKG)' unregister --force r >/dev/null 2>&1 || true + $(RM) -r p-* q-* r-* s-* t-* tmp.d *.o *.hi */*.o */*.hi */Setup$(exeext) */dist Setup$(exeext) diff --git a/testsuite/tests/cabal/t19518/Setup.hs b/testsuite/tests/cabal/t19518/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/cabal/t19518/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/cabal/t19518/all.T b/testsuite/tests/cabal/t19518/all.T new file mode 100644 index 0000000000..a2cd241a70 --- /dev/null +++ b/testsuite/tests/cabal/t19518/all.T @@ -0,0 +1,9 @@ +if config.cleanup: + cleanup = 'CLEANUP=1' +else: + cleanup = 'CLEANUP=0' + +test('t19518', + extra_files(['Setup.hs', 'p/', 'q/', 'r/']), + run_command, + ['$MAKE -s --no-print-directory t19518 ' + cleanup]) diff --git a/testsuite/tests/cabal/t19518/p/LICENSE b/testsuite/tests/cabal/t19518/p/LICENSE new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/cabal/t19518/p/LICENSE diff --git a/testsuite/tests/cabal/t19518/p/P.hs b/testsuite/tests/cabal/t19518/p/P.hs new file mode 100644 index 0000000000..f8b82de2ca --- /dev/null +++ b/testsuite/tests/cabal/t19518/p/P.hs @@ -0,0 +1,3 @@ +module P where +data P = P +p = True diff --git a/testsuite/tests/cabal/t19518/p/P2.hs b/testsuite/tests/cabal/t19518/p/P2.hs new file mode 100644 index 0000000000..769760dff8 --- /dev/null +++ b/testsuite/tests/cabal/t19518/p/P2.hs @@ -0,0 +1 @@ +module P2 where diff --git a/testsuite/tests/cabal/t19518/p/Setup.hs b/testsuite/tests/cabal/t19518/p/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/cabal/t19518/p/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/cabal/t19518/p/p.cabal b/testsuite/tests/cabal/t19518/p/p.cabal new file mode 100644 index 0000000000..989156c5be --- /dev/null +++ b/testsuite/tests/cabal/t19518/p/p.cabal @@ -0,0 +1,11 @@ +name: p +version: 0.1.0.0 +license-file: LICENSE +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.21 + +library + exposed-modules: P, P2 + build-depends: base diff --git a/testsuite/tests/cabal/t19518/q/LICENSE b/testsuite/tests/cabal/t19518/q/LICENSE new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/cabal/t19518/q/LICENSE diff --git a/testsuite/tests/cabal/t19518/q/Q.hs b/testsuite/tests/cabal/t19518/q/Q.hs new file mode 100644 index 0000000000..721b231aa1 --- /dev/null +++ b/testsuite/tests/cabal/t19518/q/Q.hs @@ -0,0 +1,4 @@ +module Q where +import P +data Q = Q +q = not p diff --git a/testsuite/tests/cabal/t19518/q/Setup.hs b/testsuite/tests/cabal/t19518/q/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/cabal/t19518/q/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/cabal/t19518/q/q.cabal b/testsuite/tests/cabal/t19518/q/q.cabal new file mode 100644 index 0000000000..c455f6ad44 --- /dev/null +++ b/testsuite/tests/cabal/t19518/q/q.cabal @@ -0,0 +1,12 @@ +name: q +version: 0.1.0.0 +license-file: LICENSE +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.21 + +library + exposed-modules: Q + reexported-modules: P + build-depends: base, p diff --git a/testsuite/tests/cabal/t19518/r/LICENSE b/testsuite/tests/cabal/t19518/r/LICENSE new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/cabal/t19518/r/LICENSE diff --git a/testsuite/tests/cabal/t19518/r/R.hs b/testsuite/tests/cabal/t19518/r/R.hs new file mode 100644 index 0000000000..ac9344a524 --- /dev/null +++ b/testsuite/tests/cabal/t19518/r/R.hs @@ -0,0 +1,3 @@ +module R where +import P +r = p diff --git a/testsuite/tests/cabal/t19518/r/Setup.hs b/testsuite/tests/cabal/t19518/r/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/cabal/t19518/r/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/cabal/t19518/r/r.cabal b/testsuite/tests/cabal/t19518/r/r.cabal new file mode 100644 index 0000000000..f39aa659f7 --- /dev/null +++ b/testsuite/tests/cabal/t19518/r/r.cabal @@ -0,0 +1,11 @@ +name: r +version: 0.1.0.0 +license-file: LICENSE +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.21 + +library + exposed-modules: R + build-depends: base, q |