driver: Fix interaction of -Wunused-packages and reexported-moduleswip/unused-packages-reexport

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

19 files changed, 142 insertions, 18 deletions

diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 7796fe61af..6c56445198 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -102,7 +102,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
@@ -124,7 +123,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
@@ -338,7 +337,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)
@@ -350,24 +349,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