diff options
| -rw-r--r-- | compiler/GHC/Driver/Errors/Ppr.hs | 14 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Errors/Types.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Make.hs | 39 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Pipeline/Execute.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Unit/State.hs | 21 | ||||
| -rw-r--r-- | testsuite/tests/cabal/t18567/T18567.stderr | 2 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T21110.stderr | 2 | ||||
| -rw-r--r-- | testsuite/tests/warnings/should_compile/UnusedPackages.stderr | 6 |
8 files changed, 42 insertions, 46 deletions
diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs index 1b604e1071..76a0ed15d3 100644 --- a/compiler/GHC/Driver/Errors/Ppr.hs +++ b/compiler/GHC/Driver/Errors/Ppr.hs @@ -19,6 +19,7 @@ import GHC.Unit.Module import GHC.Unit.State import GHC.Types.Hint import GHC.Types.SrcLoc +import Data.Version import Language.Haskell.Syntax.Decls (RuleDecl(..)) @@ -104,16 +105,23 @@ instance Diagnostic DriverMessage where -> let msg = vcat [ text "The following packages were specified" <+> text "via -package or -package-id flags," , text "but were not needed for compilation:" - , nest 2 (vcat (map (withDash . pprUnusedArg) unusedArgs)) + , nest 2 (vcat (map (withDash . displayOneUnused) unusedArgs)) ] in mkSimpleDecorated msg where withDash :: SDoc -> SDoc withDash = (<+>) (text "-") + displayOneUnused (_uid, pn , v, f) = + ppr pn <> text "-" <> text (showVersion v) + <+> parens (suffix f) + + suffix f = text "exposed by flag" <+> pprUnusedArg f + pprUnusedArg :: PackageArg -> SDoc - pprUnusedArg (PackageArg str) = text str - pprUnusedArg (UnitIdArg uid) = ppr uid + pprUnusedArg (PackageArg str) = text "-package" <+> text str + pprUnusedArg (UnitIdArg uid) = text "-package-id" <+> ppr uid + DriverUnnecessarySourceImports mod -> mkSimpleDecorated (text "{-# SOURCE #-} unnecessary in import of " <+> quotes (ppr mod)) DriverDuplicatedModuleDeclaration mod files diff --git a/compiler/GHC/Driver/Errors/Types.hs b/compiler/GHC/Driver/Errors/Types.hs index 7257b23903..015ae5e375 100644 --- a/compiler/GHC/Driver/Errors/Types.hs +++ b/compiler/GHC/Driver/Errors/Types.hs @@ -143,7 +143,7 @@ data DriverMessage where Test cases: warnings/should_compile/UnusedPackages -} - DriverUnusedPackages :: [PackageArg] -> DriverMessage + DriverUnusedPackages :: [(UnitId, PackageName, Version, PackageArg)] -> DriverMessage {-| DriverUnnecessarySourceImports (controlled with -Wunused-imports) occurs if there are {-# SOURCE #-} imports which are not necessary. See 'warnUnnecessarySourceImports' diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index c4858d04b0..de3401455f 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -264,7 +264,7 @@ instantiationNodes uid unit_state = InstantiationNode uid <$> iuids_to_check where iuids_to_check :: [InstantiatedUnit] iuids_to_check = - nubSort $ concatMap goUnitId (explicitUnits unit_state) + nubSort $ concatMap (goUnitId . fst) (explicitUnits unit_state) where goUnitId uid = [ recur @@ -460,11 +460,18 @@ warnUnusedPackages us dflags mod_graph = $ concatMap ms_imps ( filter (\ms -> homeUnitId_ dflags == ms_unitid ms) (mgModSummaries mod_graph)) - requestedArgs = mapMaybe packageArg (packageFlags dflags) + used_args = Set.fromList $ map unitId loadedPackages - unusedArgs - = filter (\arg -> not $ any (matching us arg) loadedPackages) - requestedArgs + resolve (u,mflag) = do + -- The units which we depend on via the command line explicitly + flag <- mflag + -- Which we can find the UnitInfo for (should be all of them) + ui <- lookupUnit us u + -- Which are not explicitly used + guard (Set.notMember (unitId ui) used_args) + return (unitId ui, unitPackageName ui, unitPackageVersion ui, flag) + + unusedArgs = mapMaybe resolve (explicitUnits us) warn = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan (DriverUnusedPackages unusedArgs) @@ -472,28 +479,6 @@ warnUnusedPackages us dflags mod_graph = then emptyMessages else warn - where - packageArg (ExposePackage _ arg _) = Just arg - packageArg _ = Nothing - - matchingStr :: String -> UnitInfo -> Bool - matchingStr str p - = str == unitPackageIdString p - || str == unitPackageNameString p - - matching :: UnitState -> PackageArg -> UnitInfo -> Bool - matching _ (PackageArg str) p = matchingStr str p - matching state (UnitIdArg uid) p = uid == realUnit state p - - -- For wired-in packages, we have to unwire their id, - -- otherwise they won't match package flags - realUnit :: UnitState -> UnitInfo -> Unit - realUnit state - = unwireUnit state - . RealUnit - . Definite - . unitId - -- | A ModuleGraphNode which also has a hs-boot file, and the list of nodes on any -- path from module to its boot file. diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs index 97eeb58260..909102b573 100644 --- a/compiler/GHC/Driver/Pipeline/Execute.hs +++ b/compiler/GHC/Driver/Pipeline/Execute.hs @@ -996,7 +996,7 @@ doCpp logger tmpfs dflags unit_env raw input_fn output_fn = do -- MIN_VERSION macros let uids = explicitUnits unit_state - pkgs = catMaybes (map (lookupUnit unit_state) uids) + pkgs = mapMaybe (lookupUnit unit_state . fst) uids mb_macro_include <- if not (null pkgs) && gopt Opt_VersionMacros dflags then do macro_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "h" diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs index cda5c80963..d7edd1268c 100644 --- a/compiler/GHC/Unit/State.hs +++ b/compiler/GHC/Unit/State.hs @@ -119,6 +119,7 @@ import qualified Data.Map as Map import qualified Data.Map.Strict as MapStrict import qualified Data.Set as Set import GHC.LanguageExtensions +import Control.Applicative -- --------------------------------------------------------------------------- -- The Unit state @@ -276,7 +277,7 @@ data UnitVisibility = UnitVisibility , uv_requirements :: Map ModuleName (Set InstantiatedModule) -- ^ The signatures which are contributed to the requirements context -- from this unit ID. - , uv_explicit :: Bool + , uv_explicit :: Maybe PackageArg -- ^ Whether or not this unit was explicitly brought into scope, -- as opposed to implicitly via the 'exposed' fields in the -- package database (when @-hide-all-packages@ is not passed.) @@ -298,7 +299,7 @@ instance Semigroup UnitVisibility where , uv_renamings = uv_renamings uv1 ++ uv_renamings uv2 , uv_package_name = mappend (uv_package_name uv1) (uv_package_name uv2) , uv_requirements = Map.unionWith Set.union (uv_requirements uv1) (uv_requirements uv2) - , uv_explicit = uv_explicit uv1 || uv_explicit uv2 + , uv_explicit = uv_explicit uv1 <|> uv_explicit uv2 } instance Monoid UnitVisibility where @@ -307,7 +308,7 @@ instance Monoid UnitVisibility where , uv_renamings = [] , uv_package_name = First Nothing , uv_requirements = Map.empty - , uv_explicit = False + , uv_explicit = Nothing } mappend = (Semigroup.<>) @@ -441,8 +442,10 @@ data UnitState = UnitState { preloadUnits :: [UnitId], -- | Units which we explicitly depend on (from a command line flag). - -- We'll use this to generate version macros. - explicitUnits :: [Unit], + -- We'll use this to generate version macros and the unused packages warning. The + -- original flag which was used to bring the unit into scope is recorded for the + -- -Wunused-packages warning. + explicitUnits :: [(Unit, Maybe PackageArg)], homeUnitDepends :: [UnitId], @@ -909,7 +912,7 @@ applyPackageFlag prec_map pkg_map closure unusable no_hide_others pkgs vm flag = , uv_renamings = rns , uv_package_name = First (Just n) , uv_requirements = reqs - , uv_explicit = True + , uv_explicit = Just arg } vm' = Map.insertWith mappend (mkUnit p) uv vm_cleared -- In the old days, if you said `ghc -package p-0.1 -package p-0.2` @@ -1573,7 +1576,7 @@ mkUnitState logger cfg = do uv_renamings = [], uv_package_name = First (Just (fsPackageName p)), uv_requirements = Map.empty, - uv_explicit = False + uv_explicit = Nothing } vm else vm) @@ -1636,7 +1639,7 @@ mkUnitState logger cfg = do -- The requirement context is directly based off of this: we simply -- look for nested unit IDs that are directly fed holes: the requirements -- of those units are precisely the ones we need to track - let explicit_pkgs = Map.keys vis_map + let explicit_pkgs = [(k, uv_explicit v) | (k, v) <- Map.toList vis_map] req_ctx = Map.map (Set.toList) $ Map.unionsWith Set.union (map uv_requirements (Map.elems vis_map)) @@ -1651,7 +1654,7 @@ mkUnitState logger cfg = do -- NB: preload IS important even for type-checking, because we -- need the correct include path to be set. -- - let preload1 = Map.keys (Map.filter uv_explicit vis_map) + let preload1 = Map.keys (Map.filter (isJust . uv_explicit) vis_map) -- add default preload units if they can be found in the db basicLinkedUnits = fmap (RealUnit . Definite) diff --git a/testsuite/tests/cabal/t18567/T18567.stderr b/testsuite/tests/cabal/t18567/T18567.stderr index 660c39cc22..4330d06d80 100644 --- a/testsuite/tests/cabal/t18567/T18567.stderr +++ b/testsuite/tests/cabal/t18567/T18567.stderr @@ -2,4 +2,4 @@ <no location info>: warning: [-Wunused-packages] The following packages were specified via -package or -package-id flags, but were not needed for compilation: - - internal-lib-0.1.0.0-1ShKL1eXB3aGPfTSujH0Bv-sublib-unused + - internal-lib-0.1.0.0 (exposed by flag -package-id internal-lib-0.1.0.0-1ShKL1eXB3aGPfTSujH0Bv-sublib-unused) diff --git a/testsuite/tests/ghci/scripts/T21110.stderr b/testsuite/tests/ghci/scripts/T21110.stderr index 202cf086f8..ee36c6148f 100644 --- a/testsuite/tests/ghci/scripts/T21110.stderr +++ b/testsuite/tests/ghci/scripts/T21110.stderr @@ -2,4 +2,4 @@ <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 + - template-haskell-2.18.0.0 (exposed by flag -package template-haskell) diff --git a/testsuite/tests/warnings/should_compile/UnusedPackages.stderr b/testsuite/tests/warnings/should_compile/UnusedPackages.stderr index 11f87e6de4..94c487e550 100644 --- a/testsuite/tests/warnings/should_compile/UnusedPackages.stderr +++ b/testsuite/tests/warnings/should_compile/UnusedPackages.stderr @@ -2,8 +2,8 @@ <no location info>: warning: [-Wunused-packages] The following packages were specified via -package or -package-id flags, but were not needed for compilation: - - ghc - - process - - bytestring + - bytestring-0.11.2.0 (exposed by flag -package bytestring) + - ghc-9.3 (exposed by flag -package ghc) + - process-1.6.13.2 (exposed by flag -package process) [1 of 2] Compiling Main ( UnusedPackages.hs, UnusedPackages.o ) [2 of 2] Linking UnusedPackages |