summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Driver/Make.hs24
-rw-r--r--compiler/GHC/Unit/Finder.hs2
-rw-r--r--compiler/GHC/Unit/State.hs28
-rw-r--r--testsuite/tests/cabal/t19518/Makefile44
-rw-r--r--testsuite/tests/cabal/t19518/Setup.hs2
-rw-r--r--testsuite/tests/cabal/t19518/all.T9
-rw-r--r--testsuite/tests/cabal/t19518/p/LICENSE0
-rw-r--r--testsuite/tests/cabal/t19518/p/P.hs3
-rw-r--r--testsuite/tests/cabal/t19518/p/P2.hs1
-rw-r--r--testsuite/tests/cabal/t19518/p/Setup.hs2
-rw-r--r--testsuite/tests/cabal/t19518/p/p.cabal11
-rw-r--r--testsuite/tests/cabal/t19518/q/LICENSE0
-rw-r--r--testsuite/tests/cabal/t19518/q/Q.hs4
-rw-r--r--testsuite/tests/cabal/t19518/q/Setup.hs2
-rw-r--r--testsuite/tests/cabal/t19518/q/q.cabal12
-rw-r--r--testsuite/tests/cabal/t19518/r/LICENSE0
-rw-r--r--testsuite/tests/cabal/t19518/r/R.hs3
-rw-r--r--testsuite/tests/cabal/t19518/r/Setup.hs2
-rw-r--r--testsuite/tests/cabal/t19518/r/r.cabal11
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
View Lorry Controller Status