Fix behaviour of -Wunused-packages in ghci

Ticket #21110 points out that -Wunused-packages behaves a bit unusually
in GHCi. Now we define the semantics for -Wunused-packages in
interactive mode as follows:

* If you use -Wunused-packages on an initial load then the warning is reported.
* If you explicitly set -Wunused-packages on the command line then the
  warning is displayed (until it is disabled)
* If you then subsequently modify the set of available targets by using
  :load or :cd (:cd unloads everything) then the warning is (silently)
  turned off.

This means that every :r the warning is printed if it's turned on (but you did ask for it).

Fixes #21110

9 files changed, 83 insertions, 41 deletions

diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs
index 8bc1f516bf..0d52ecc7cc 100644
--- a/compiler/GHC/Driver/Env.hs
+++ b/compiler/GHC/Driver/Env.hs
@@ -32,6 +32,7 @@ module GHC.Driver.Env
    , hptSomeThingsBelowUs
    , hptRules
    , prepareAnnotations
+   , discardIC
    , lookupType
    , lookupIfaceByModule
    , mainModIs
@@ -421,3 +422,27 @@ hscSetActiveUnitId uid e = e
 
 hscActiveUnitId :: HscEnv -> UnitId
 hscActiveUnitId e = ue_currentUnit (hsc_unit_env e)
+
+-- | Discard the contents of the InteractiveContext, but keep the DynFlags and
+-- the loaded plugins.  It will also keep ic_int_print and ic_monad if their
+-- names are from external packages.
+discardIC :: HscEnv -> HscEnv
+discardIC hsc_env
+  = hsc_env { hsc_IC = empty_ic { ic_int_print = new_ic_int_print
+                                , ic_monad     = new_ic_monad
+                                , ic_plugins   = old_plugins
+                                } }
+  where
+  -- Force the new values for ic_int_print and ic_monad to avoid leaking old_ic
+  !new_ic_int_print = keep_external_name ic_int_print
+  !new_ic_monad = keep_external_name ic_monad
+  !old_plugins = ic_plugins old_ic
+  dflags = ic_dflags old_ic
+  old_ic = hsc_IC hsc_env
+  empty_ic = emptyInteractiveContext dflags
+  keep_external_name ic_name
+    | nameIsFromExternalPackage home_unit old_name = old_name
+    | otherwise = ic_name empty_ic
+    where
+    home_unit = hsc_home_unit hsc_env
+    old_name = ic_name old_ic
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 05574f8ad8..0c41dbbda6 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -61,7 +61,6 @@ import GHC.Runtime.Interpreter
 import qualified GHC.Linker.Loader as Linker
 import GHC.Linker.Types
 
-import GHC.Runtime.Context
 import GHC.Platform.Ways
 
 import GHC.Driver.Config.Finder (initFinderOpts)
@@ -107,7 +106,6 @@ import GHC.Types.SourceFile
 import GHC.Types.SourceError
 import GHC.Types.SrcLoc
 import GHC.Types.Unique.FM
-import GHC.Types.Name
 import GHC.Types.PkgQual
 
 import GHC.Unit
@@ -706,29 +704,6 @@ loadFinish all_ok
   = do modifySession discardIC
        return all_ok
 
--- | Discard the contents of the InteractiveContext, but keep the DynFlags and
--- the loaded plugins.  It will also keep ic_int_print and ic_monad if their
--- names are from external packages.
-discardIC :: HscEnv -> HscEnv
-discardIC hsc_env
-  = hsc_env { hsc_IC = empty_ic { ic_int_print = new_ic_int_print
-                                , ic_monad     = new_ic_monad
-                                , ic_plugins   = old_plugins
-                                } }
-  where
-  -- Force the new values for ic_int_print and ic_monad to avoid leaking old_ic
-  !new_ic_int_print = keep_external_name ic_int_print
-  !new_ic_monad = keep_external_name ic_monad
-  !old_plugins = ic_plugins old_ic
-  dflags = ic_dflags old_ic
-  old_ic = hsc_IC hsc_env
-  empty_ic = emptyInteractiveContext dflags
-  keep_external_name ic_name
-    | nameIsFromExternalPackage home_unit old_name = old_name
-    | otherwise = ic_name empty_ic
-    where
-    home_unit = hsc_home_unit hsc_env
-    old_name = ic_name old_ic
 
 -- | If there is no -o option, guess the name of target executable
 -- by using top-level source file name as a base.
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 5b2c85099b..9eaf63ed80 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -2085,7 +2085,7 @@ of ``-W(no-)*``.
         data Foo = Foo { f :: Int } | Bar
 
 .. ghc-flag:: -Wunused-packages
-    :shortdesc: warn when package is requested on command line, but was never loaded.
+    :shortdesc: warn when package is requested on command line, but not needed.
     :type: dynamic
     :reverse: -Wno-unused-packages
     :category:
@@ -2094,11 +2094,15 @@ of ``-W(no-)*``.
 
     The option :ghc-flag:`-Wunused-packages` warns about packages, specified on
     command line via :ghc-flag:`-package ⟨pkg⟩` or
-    :ghc-flag:`-package-id ⟨unit-id⟩`, but were not loaded during compilation.
-    Usually it means that you have an unused dependency.
+    :ghc-flag:`-package-id ⟨unit-id⟩`, but were not needed during compilation.
+    If the warning fires it means the specified package wasn't needed for
+    compilation.
+
+    This warning interacts poorly with GHCi because most invocations will pass
+    a large number of ``-package`` arguments on the initial load. Therefore if
+    you modify the targets using ``:load`` or ``:cd`` then the warning will be
+    silently disabled if it's enabled (see :ghc-ticket:`21110`).
 
-    You may want to enable this warning on a clean build or enable :ghc-flag:`-fforce-recomp`
-    in order to get reliable results.
 
 .. ghc-flag:: -Winvalid-haddock
     :shortdesc: warn when a Haddock comment occurs in an invalid position
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 76d714c3e6..68519f5ce7 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -135,6 +135,8 @@ import Prelude hiding ((<>))
 import GHC.Utils.Exception as Exception hiding (catch, mask, handle)
 import Foreign hiding (void)
 import GHC.Stack hiding (SrcLoc(..))
+import GHC.Unit.Env
+import GHC.Unit.Home.ModInfo
 
 import System.Directory
 import System.Environment
@@ -1655,8 +1657,8 @@ changeDirectory dir = do
   graph <- GHC.getModuleGraph
   when (not (null $ GHC.mgModSummaries graph)) $
         liftIO $ putStrLn "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed."
-  -- delete targets and all eventually defined breakpoints (#1620)
-  clearAllTargets
+  -- delete defined breakpoints and clear the interface file cache (#1620)
+  clearCaches
   setContextAfterLoad False Nothing
   GHC.workingDirectoryChanged
   dir' <- expandPath dir
@@ -2030,7 +2032,7 @@ loadModule' files = do
   let load_module = do
         -- unload first
         _ <- GHC.abandonAll
-        clearAllTargets
+        clearCaches
 
         GHC.setTargets targets
         doLoadAndCollectInfo False LoadAllTargets
@@ -3150,8 +3152,8 @@ newDynFlags interactive_only minus_opts = do
           when (verbosity dflags2 > 0) $
             liftIO . putStrLn $
               "package flags have changed, resetting and loading new packages..."
-          -- delete targets and all eventually defined breakpoints. (#1620)
-          clearAllTargets
+          -- Clear caches and eventually defined breakpoints. (#1620)
+          clearCaches
           when must_reload $ do
             let units = preloadUnits (hsc_units hsc_env)
             liftIO $ Loader.loadPackages interp hsc_env units
@@ -4446,6 +4448,22 @@ discardInterfaceCache :: GhciMonad m => m ()
 discardInterfaceCache = do
    modifyGHCiState $ (\st -> st { hmiCache = [] })
 
+clearHPTs :: GhciMonad m => m ()
+clearHPTs = do
+  let pruneHomeUnitEnv hme = hme { homeUnitEnv_hpt = emptyHomePackageTable }
+      discardMG hsc = hsc { hsc_mod_graph = GHC.emptyMG }
+  modifySession (discardMG . discardIC . hscUpdateHUG (unitEnv_map pruneHomeUnitEnv))
+
+
+-- The unused package warning doesn't make sense once the targets get out of
+-- sync with the package flags. See #21110
+-- Therefore if it's turned on, the warnings are issued until the module context
+-- changes (via :load or :cd), at which stage the package flags are not going to change
+-- but the loaded modules will probably not use all the specified packages so the
+-- warning becomes spurious. At that point the warning is silently disabled.
+disableUnusedPackages :: GhciMonad m => m ()
+disableUnusedPackages = newDynFlags False ["-Wno-unused-packages"]
+
 deleteBreak :: GhciMonad m => Int -> m ()
 deleteBreak identity = do
    st <- getGHCiState
@@ -4636,12 +4654,13 @@ wantNameFromInterpretedModule noCanDo str and_then =
                                 text " is not interpreted"
                else and_then n
 
-clearAllTargets :: GhciMonad m => m ()
-clearAllTargets = discardActiveBreakPoints
-                >> discardInterfaceCache
-                >> GHC.setTargets []
-                >> GHC.load LoadAllTargets
-                >> pure ()
+clearCaches :: GhciMonad m => m ()
+clearCaches = discardActiveBreakPoints
+              >> discardInterfaceCache
+              >> disableUnusedPackages
+              >> clearHPTs
+
+
 
 -- Split up a string with an eventually qualified declaration name into 3 components
 --   1. module name
diff --git a/testsuite/tests/ghci/scripts/T21110.hs b/testsuite/tests/ghci/scripts/T21110.hs
new file mode 100644
index 0000000000..e43090a725
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T21110.hs
@@ -0,0 +1,3 @@
+module T21110 where
+
+import GHC
diff --git a/testsuite/tests/ghci/scripts/T21110.script b/testsuite/tests/ghci/scripts/T21110.script
new file mode 100644
index 0000000000..bb8375f9f1
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T21110.script
@@ -0,0 +1,7 @@
+:set -package ghc -package template-haskell
+:l T21110.hs
+:set -Wunused-packages
+-- Warning about not using template-haskell
+:r
+-- No warning
+:l T21110A.hs
diff --git a/testsuite/tests/ghci/scripts/T21110.stderr b/testsuite/tests/ghci/scripts/T21110.stderr
new file mode 100644
index 0000000000..202cf086f8
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T21110.stderr
@@ -0,0 +1,5 @@
+
+<no location info>: warning: [-Wunused-packages]
+    The following packages were specified via -package or -package-id flags,
+    but were not needed for compilation:
+      - template-haskell
diff --git a/testsuite/tests/ghci/scripts/T21110A.hs b/testsuite/tests/ghci/scripts/T21110A.hs
new file mode 100644
index 0000000000..fd690c87e3
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T21110A.hs
@@ -0,0 +1 @@
+module T21110A where
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 0f6ed54ddb..08e431ef33 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -364,3 +364,6 @@ test('T20909', normal, ghci_script, ['T20909.script'])
 test('T20150', normal, ghci_script, ['T20150.script'])
 test('T20974', normal, ghci_script, ['T20974.script'])
 test('T21088', normal, ghci_script, ['T21088.script'])
+test('T21110', [extra_files(['T21110A.hs'])], ghci_script,
+                ['T21110.script'])
+