diff options
author | Edward Z. Yang <ezyang@cs.stanford.edu> | 2015-12-18 18:29:52 -0800 |
---|---|---|
committer | Edward Z. Yang <ezyang@cs.stanford.edu> | 2015-12-22 14:23:16 -0800 |
commit | 1faf1fcaebb2871f8085b01d0c6d19eec11dc808 (patch) | |
tree | ff61505ef4e115f5b13933b5e05a574d507629f5 | |
parent | 998739df630cbee7d006329a76786239e3e2c0be (diff) | |
download | haskell-1faf1fcaebb2871f8085b01d0c6d19eec11dc808.tar.gz |
Implement -hide-all-plugin-packages and -plugin-package(-id), fixing #11244
Summary:
The basic idea is that we have a new set of "exposed modules"
which are /only/ used for plugins, i.e. -fplugin Foo and
--frontend Foo. You can interact with this namespace
using the flags -plugin-package-id and -plugin-package.
By default, this namespace contains all modules in the
user namespace (as before), but you can toggle that using
-hide-all-plugin-packages.
There is one nasty hack: GhcMake respects -fplugin in
GHC_OPTIONS to make local plugins work correctly. It also
bails out of you have an import of a module which doesn't
exist locally or in the package database. The upshot is
that we need to be sure to check in the plugin modules
too, so we don't give a spurious failure when a plugin
is in the plugin namespace but not the main namespace.
A better way to fix this would be to distinguish between
plugin and normal dependencies in ModSummary.
I cheated a little and tweaked a few existing plugins
tests to exercise the new code paths.
TODO: Documentation
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate
Reviewers: bgamari, austin, simonpj, duncan
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1661
GHC Trac Issues: #11244
-rw-r--r-- | compiler/main/DynFlags.hs | 49 | ||||
-rw-r--r-- | compiler/main/DynamicLoading.hs | 6 | ||||
-rw-r--r-- | compiler/main/Finder.hs | 27 | ||||
-rw-r--r-- | compiler/main/Packages.hs | 111 | ||||
-rw-r--r-- | docs/users_guide/extending_ghc.rst | 51 | ||||
-rw-r--r-- | docs/users_guide/packages.rst | 2 | ||||
-rw-r--r-- | ghc/GHCi/UI.hs | 12 | ||||
-rw-r--r-- | testsuite/.gitignore | 1 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/T9595.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/plugins/Makefile | 16 | ||||
-rw-r--r-- | testsuite/tests/plugins/T11244.hs | 1 | ||||
-rw-r--r-- | testsuite/tests/plugins/T11244.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/plugins/all.T | 6 |
13 files changed, 233 insertions, 55 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 5844bc0dc2..5efe8b3486 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -404,6 +404,7 @@ data GeneralFlag | Opt_SplitSections | Opt_StgStats | Opt_HideAllPackages + | Opt_HideAllPluginPackages | Opt_PrintBindResult | Opt_Haddock | Opt_HaddockOptions @@ -696,6 +697,8 @@ data DynFlags = DynFlags { -- ^ The @-ignore-package@ flags from the command line packageFlags :: [PackageFlag], -- ^ The @-package@ and @-hide-package@ flags from the command-line + pluginPackageFlags :: [PackageFlag], + -- ^ The @-plugin-package-id@ flags from command line trustFlags :: [TrustFlag], -- ^ The @-trust@ and @-distrust@ flags packageEnv :: Maybe FilePath, @@ -1092,18 +1095,24 @@ data ModRenaming = ModRenaming { -- under name @n@. } deriving (Eq) --- | Flags for manipulating packages. +-- | Flags for manipulating the set of non-broken packages. newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@ + deriving (Eq) +-- | Flags for manipulating package trust. data TrustFlag = TrustPackage String -- ^ @-trust@ | DistrustPackage String -- ^ @-distrust@ + deriving (Eq) +-- | Flags for manipulating packages visibility. data PackageFlag - = ExposePackage PackageArg ModRenaming -- ^ @-package@, @-package-id@ + = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@ -- and @-package-key@ | HidePackage String -- ^ @-hide-package@ deriving (Eq) +-- NB: equality instance is used by InteractiveUI to test if +-- package flags have changed. defaultHscTarget :: Platform -> HscTarget defaultHscTarget = defaultObjectTarget @@ -1432,6 +1441,7 @@ defaultDynFlags mySettings = extraPkgConfs = id, packageFlags = [], + pluginPackageFlags = [], ignorePackageFlags = [], trustFlags = [], packageEnv = Nothing, @@ -2710,9 +2720,12 @@ package_flags = [ , defGhcFlag "this-package-key" (hasArg setUnitId) , defFlag "package-id" (HasArg exposePackageId) , defFlag "package" (HasArg exposePackage) + , defFlag "plugin-package-id" (HasArg exposePluginPackageId) + , defFlag "plugin-package" (HasArg exposePluginPackage) , defFlag "package-key" (HasArg exposeUnitId) , defFlag "hide-package" (HasArg hidePackage) , defFlag "hide-all-packages" (NoArg (setGeneralFlag Opt_HideAllPackages)) + , defFlag "hide-all-plugin-packages" (NoArg (setGeneralFlag Opt_HideAllPluginPackages)) , defFlag "package-env" (HasArg setPackageEnv) , defFlag "ignore-package" (HasArg ignorePackage) , defFlag "syslib" @@ -3751,18 +3764,22 @@ parseModuleName :: ReadP ModuleName parseModuleName = fmap mkModuleName $ munch1 (\c -> isAlphaNum c || c `elem` "_.") -parsePackageFlag :: (String -> PackageArg) -- type of argument +parsePackageFlag :: String -- the flag + -> (String -> PackageArg) -- type of argument -> String -- string to parse -> PackageFlag -parsePackageFlag constr str = case filter ((=="").snd) (readP_to_S parse str) of +parsePackageFlag flag constr str + = case filter ((=="").snd) (readP_to_S parse str) of [(r, "")] -> r _ -> throwGhcException $ CmdLineError ("Can't parse package flag: " ++ str) - where parse = do + where doc = flag ++ " " ++ str + parse = do pkg <- tok $ munch1 (\c -> isAlphaNum c || c `elem` ":-_.") + let mk_expose = ExposePackage doc (constr pkg) ( do _ <- tok $ string "with" - fmap (ExposePackage (constr pkg) . ModRenaming True) parseRns - <++ fmap (ExposePackage (constr pkg) . ModRenaming False) parseRns - <++ return (ExposePackage (constr pkg) (ModRenaming True []))) + fmap (mk_expose . ModRenaming True) parseRns + <++ fmap (mk_expose . ModRenaming False) parseRns + <++ return (mk_expose (ModRenaming True []))) parseRns = do _ <- tok $ R.char '(' rns <- tok $ sepBy parseItem (tok $ R.char ',') _ <- tok $ R.char ')' @@ -3776,15 +3793,23 @@ parsePackageFlag constr str = case filter ((=="").snd) (readP_to_S parse str) of return (orig, orig)) tok m = m >>= \x -> skipSpaces >> return x -exposePackage, exposePackageId, exposeUnitId, hidePackage, ignorePackage, +exposePackage, exposePackageId, exposeUnitId, hidePackage, + exposePluginPackage, exposePluginPackageId, + ignorePackage, trustPackage, distrustPackage :: String -> DynP () exposePackage p = upd (exposePackage' p) exposePackageId p = upd (\s -> s{ packageFlags = - parsePackageFlag PackageIdArg p : packageFlags s }) + parsePackageFlag "-package-id" PackageIdArg p : packageFlags s }) +exposePluginPackage p = + upd (\s -> s{ pluginPackageFlags = + parsePackageFlag "-plugin-package" PackageArg p : pluginPackageFlags s }) +exposePluginPackageId p = + upd (\s -> s{ pluginPackageFlags = + parsePackageFlag "-plugin-package-id" PackageIdArg p : pluginPackageFlags s }) exposeUnitId p = upd (\s -> s{ packageFlags = - parsePackageFlag UnitIdArg p : packageFlags s }) + parsePackageFlag "-package-key" UnitIdArg p : packageFlags s }) hidePackage p = upd (\s -> s{ packageFlags = HidePackage p : packageFlags s }) ignorePackage p = @@ -3798,7 +3823,7 @@ distrustPackage p = exposePackage p >> exposePackage' :: String -> DynFlags -> DynFlags exposePackage' p dflags = dflags { packageFlags = - parsePackageFlag PackageArg p : packageFlags dflags } + parsePackageFlag "-package" PackageArg p : packageFlags dflags } setUnitId :: String -> DynFlags -> DynFlags setUnitId p s = s{ thisPackage = stringToUnitId p } diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs index bbaf12978b..ba351457df 100644 --- a/compiler/main/DynamicLoading.hs +++ b/compiler/main/DynamicLoading.hs @@ -26,7 +26,7 @@ module DynamicLoading ( import Linker ( linkModule, getHValue ) import GHCi ( wormhole ) import SrcLoc ( noSrcSpan ) -import Finder ( findImportedModule, cannotFindModule ) +import Finder ( findPluginModule, cannotFindModule ) import TcRnMonad ( initTcInteractive, initIfaceTcRn ) import LoadIface ( loadPluginInterface ) import RdrName ( RdrName, ImportSpec(..), ImpDeclSpec(..) @@ -203,12 +203,10 @@ lessUnsafeCoerce dflags context what = do -- loaded very partially: just enough that it can be used, without its -- rules and instances affecting (and being linked from!) the module -- being compiled. This was introduced by 57d6798. --- --- See Note [Care with plugin imports] in LoadIface. lookupRdrNameInModuleForPlugins :: HscEnv -> ModuleName -> RdrName -> IO (Maybe Name) lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do -- First find the package the module resides in by searching exposed packages and home modules - found_module <- findImportedModule hsc_env mod_name Nothing + found_module <- findPluginModule hsc_env mod_name case found_module of Found _ mod -> do -- Find the exports of the module diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs index c6bbd7583f..dddc09a6eb 100644 --- a/compiler/main/Finder.hs +++ b/compiler/main/Finder.hs @@ -10,6 +10,7 @@ module Finder ( flushFinderCaches, FindResult(..), findImportedModule, + findPluginModule, findExactModule, findHomeModule, findExposedPackageModule, @@ -89,7 +90,7 @@ lookupFinderCache ref key = do return $! lookupModuleEnv c key -- ----------------------------------------------------------------------------- --- The two external entry points +-- The three external entry points -- | Locate a module that was imported by the user. We have the -- module's name, and possibly a package name. Without a package @@ -112,6 +113,16 @@ findImportedModule hsc_env mod_name mb_pkg = `orIfNotFound` findExposedPackageModule hsc_env mod_name Nothing +-- | Locate a plugin module requested by the user, for a compiler +-- plugin. This consults the same set of exposed packages as +-- 'findImportedModule', unless @-hide-all-plugin-packages@ or +-- @-plugin-package@ are specified. +findPluginModule :: HscEnv -> ModuleName -> IO FindResult +findPluginModule hsc_env mod_name = + findHomeModule hsc_env mod_name + `orIfNotFound` + findExposedPluginPackageModule hsc_env mod_name + -- | Locate a specific 'Module'. The purpose of this function is to -- create a 'ModLocation' for a given 'Module', that is to find out -- where the files associated with this module live. It is used when @@ -160,7 +171,19 @@ homeSearchCache hsc_env mod_name do_this = do findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult findExposedPackageModule hsc_env mod_name mb_pkg - = case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name mb_pkg of + = findLookupResult hsc_env + $ lookupModuleWithSuggestions + (hsc_dflags hsc_env) mod_name mb_pkg + +findExposedPluginPackageModule :: HscEnv -> ModuleName + -> IO FindResult +findExposedPluginPackageModule hsc_env mod_name + = findLookupResult hsc_env + $ lookupPluginModuleWithSuggestions + (hsc_dflags hsc_env) mod_name Nothing + +findLookupResult :: HscEnv -> LookupResult -> IO FindResult +findLookupResult hsc_env r = case r of LookupFound m pkg_conf -> findPackageModule_ hsc_env m pkg_conf LookupMultiple rs -> diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index f9a63aa3a7..2849b7e70a 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -23,6 +23,7 @@ module Packages ( listVisibleModuleNames, lookupModuleInAllPackages, lookupModuleWithSuggestions, + lookupPluginModuleWithSuggestions, LookupResult(..), ModuleSuggestion(..), ModuleOrigin(..), @@ -269,7 +270,10 @@ data PackageState = PackageState { -- | This is a full map from 'ModuleName' to all modules which may possibly -- be providing it. These providers may be hidden (but we'll still want -- to report them in error messages), or it may be an ambiguous import. - moduleToPkgConfAll :: ModuleToPkgConfAll + moduleToPkgConfAll :: ModuleToPkgConfAll, + + -- | A map, like 'moduleToPkgConfAll', but controlling plugin visibility. + pluginModuleToPkgConfAll :: ModuleToPkgConfAll } emptyPackageState :: PackageState @@ -277,7 +281,8 @@ emptyPackageState = PackageState { pkgIdMap = emptyUFM, preloadPackages = [], explicitPackages = [], - moduleToPkgConfAll = Map.empty + moduleToPkgConfAll = Map.empty, + pluginModuleToPkgConfAll = Map.empty } type InstalledPackageIndex = Map UnitId PackageConfig @@ -531,14 +536,16 @@ applyTrustFlag dflags unusable pkgs flag = applyPackageFlag :: DynFlags -> UnusablePackages + -> Bool -- if False, if you expose a package, it implicitly hides + -- any previously exposed packages with the same name -> [PackageConfig] -> VisibilityMap -- Initially exposed -> PackageFlag -- flag to apply -> IO VisibilityMap -- Now exposed -applyPackageFlag dflags unusable pkgs vm flag = +applyPackageFlag dflags unusable no_hide_others pkgs vm flag = case flag of - ExposePackage arg (ModRenaming b rns) -> + ExposePackage _ arg (ModRenaming b rns) -> case selectPackages (matching arg) pkgs unusable of Left ps -> packageFlagErr dflags flag ps Right (p:_,_) -> return vm' @@ -546,10 +553,27 @@ applyPackageFlag dflags unusable pkgs vm flag = n = fsPackageName p vm' = addToUFM_C edit vm_cleared (packageConfigId p) (b, rns, n) edit (b, rns, n) (b', rns', _) = (b || b', rns ++ rns', n) - -- ToDo: ATM, -hide-all-packages implicitly triggers change in - -- behavior, maybe eventually make it toggleable with a separate - -- flag - vm_cleared | gopt Opt_HideAllPackages dflags = vm + -- In the old days, if you said `ghc -package p-0.1 -package p-0.2` + -- (or if p-0.1 was registered in the pkgdb as exposed: True), + -- the second package flag would override the first one and you + -- would only see p-0.2 in exposed modules. This is good for + -- usability. + -- + -- However, with thinning and renaming (or Backpack), there might be + -- situations where you legitimately want to see two versions of a + -- package at the same time, and this behavior would make it + -- impossible to do so. So we decided that if you pass + -- -hide-all-packages, this should turn OFF the overriding behavior + -- where an exposed package hides all other packages with the same + -- name. This should not affect Cabal at all, which only ever + -- exposes one package at a time. + -- + -- NB: Why a variable no_hide_others? We have to apply this logic to + -- -plugin-package too, and it's more consistent if the switch in + -- behavior is based off of + -- -hide-all-packages/-hide-all-plugin-packages depending on what + -- flag is in question. + vm_cleared | no_hide_others = vm | otherwise = filterUFM_Directly (\k (_,_,n') -> k == getUnique (packageConfigId p) || n /= n') vm @@ -602,7 +626,7 @@ packageFlagErr :: DynFlags -- for missing DPH package we emit a more helpful error message, because -- this may be the result of using -fdph-par or -fdph-seq. -packageFlagErr dflags (ExposePackage (PackageArg pkg) _) [] +packageFlagErr dflags (ExposePackage _ (PackageArg pkg) _) [] | is_dph_package pkg = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ dph_err)) where dph_err = text "the " <> text pkg <> text " package is not installed." @@ -635,17 +659,7 @@ packageFlagErr' dflags flag_doc reasons pprFlag :: PackageFlag -> SDoc pprFlag flag = case flag of HidePackage p -> text "-hide-package " <> text p - ExposePackage a rns -> ppr_arg a <> ppr_rns rns - where ppr_arg arg = case arg of - PackageArg p -> text "-package " <> text p - PackageIdArg p -> text "-package-id " <> text p - UnitIdArg p -> text "-package-key " <> text p - ppr_rns (ModRenaming True []) = Outputable.empty - ppr_rns (ModRenaming b rns) = - if b then text "with" else Outputable.empty <+> - char '(' <> hsep (punctuate comma (map ppr_rn rns)) <> char ')' - ppr_rn (orig, new) | orig == new = ppr orig - | otherwise = ppr orig <+> text "as" <+> ppr new + ExposePackage doc _ _ -> text doc pprTrustFlag :: TrustFlag -> SDoc pprTrustFlag flag = case flag of @@ -1016,7 +1030,8 @@ mkPackageState dflags0 dbs preload0 = do -- -hide-package). This needs to know about the unusable packages, since if a -- user tries to enable an unusable package, we should let them know. -- - vis_map2 <- foldM (applyPackageFlag dflags unusable pkgs1) + vis_map2 <- foldM (applyPackageFlag dflags unusable + (gopt Opt_HideAllPackages dflags) pkgs1) vis_map1 other_flags -- @@ -1029,6 +1044,33 @@ mkPackageState dflags0 dbs preload0 = do -- Update the visibility map, so we treat wired packages as visible. let vis_map = updateVisibilityMap wired_map vis_map2 + let hide_plugin_pkgs = gopt Opt_HideAllPluginPackages dflags + plugin_vis_map <- + case pluginPackageFlags dflags of + -- common case; try to share the old vis_map + [] | not hide_plugin_pkgs -> return vis_map + | otherwise -> return emptyUFM + _ -> do let plugin_vis_map1 + | hide_plugin_pkgs = emptyUFM + -- Use the vis_map PRIOR to wired in, + -- because otherwise applyPackageFlag + -- won't work. + | otherwise = vis_map2 + plugin_vis_map2 + <- foldM (applyPackageFlag dflags unusable + (gopt Opt_HideAllPluginPackages dflags) pkgs1) + plugin_vis_map1 + (reverse (pluginPackageFlags dflags)) + -- Updating based on wired in packages is mostly + -- good hygiene, because it won't matter: no wired in + -- package has a compiler plugin. + -- TODO: If a wired in package had a compiler plugin, + -- and you tried to pick different wired in packages + -- with the plugin flags and the normal flags... what + -- would happen? I don't know! But this doesn't seem + -- likely to actually happen. + return (updateVisibilityMap wired_map plugin_vis_map2) + -- -- Here we build up a set of the packages mentioned in -package -- flags on the command line; these are called the "preload" @@ -1040,7 +1082,7 @@ mkPackageState dflags0 dbs preload0 = do in fromMaybe key (Map.lookup key wired_map) | f <- other_flags, p <- get_exposed f ] - get_exposed (ExposePackage a _) = take 1 . sortByVersion + get_exposed (ExposePackage _ a _) = take 1 . sortByVersion . filter (matching a) $ pkgs1 get_exposed _ = [] @@ -1073,7 +1115,8 @@ mkPackageState dflags0 dbs preload0 = do then packageConfigId pkg : xs else xs) [] pkg_db, pkgIdMap = pkg_db, - moduleToPkgConfAll = mkModuleToPkgConfAll dflags pkg_db vis_map + moduleToPkgConfAll = mkModuleToPkgConfAll dflags pkg_db vis_map, + pluginModuleToPkgConfAll = mkModuleToPkgConfAll dflags pkg_db plugin_vis_map } return (pstate, new_dep_preload, this_package) @@ -1270,8 +1313,25 @@ lookupModuleWithSuggestions :: DynFlags -> ModuleName -> Maybe FastString -> LookupResult -lookupModuleWithSuggestions dflags m mb_pn - = case Map.lookup m (moduleToPkgConfAll pkg_state) of +lookupModuleWithSuggestions dflags + = lookupModuleWithSuggestions' dflags + (moduleToPkgConfAll (pkgState dflags)) + +lookupPluginModuleWithSuggestions :: DynFlags + -> ModuleName + -> Maybe FastString + -> LookupResult +lookupPluginModuleWithSuggestions dflags + = lookupModuleWithSuggestions' dflags + (pluginModuleToPkgConfAll (pkgState dflags)) + +lookupModuleWithSuggestions' :: DynFlags + -> ModuleToPkgConfAll + -> ModuleName + -> Maybe FastString + -> LookupResult +lookupModuleWithSuggestions' dflags mod_map m mb_pn + = case Map.lookup m mod_map of Nothing -> LookupNotFound suggestions Just xs -> case foldl' classify ([],[],[]) (Map.toList xs) of @@ -1290,7 +1350,6 @@ lookupModuleWithSuggestions dflags m mb_pn | otherwise -> (x:hidden_pkg, hidden_mod, exposed) pkg_lookup = expectJust "lookupModuleWithSuggestions" . lookupPackage dflags - pkg_state = pkgState dflags mod_pkg = pkg_lookup . moduleUnitId -- Filters out origins which are not associated with the given package diff --git a/docs/users_guide/extending_ghc.rst b/docs/users_guide/extending_ghc.rst index bb127957df..4cd15f5be1 100644 --- a/docs/users_guide/extending_ghc.rst +++ b/docs/users_guide/extending_ghc.rst @@ -213,9 +213,54 @@ would invoke GHC like this: Linking Test ... $ -Since plugins are exported by registered packages, it's safe to put -dependencies on them in cabal for example, and specify plugin arguments -to GHC through the ``ghc-options`` field. +Plugin modules live in a separate namespace from +the user import namespace. By default, these two namespaces are +the same; however, there are a few command line options which +control specifically plugin packages: + +``-plugin-package ⟨pkg⟩`` + .. index:: + single: -plugin-package + + This option causes the installed package ⟨pkg⟩ to be exposed + for plugins, such as ``-fplugin``. The + package ⟨pkg⟩ can be specified in full with its version number (e.g. + ``network-1.0``) or the version number can be omitted if there is + only one version of the package installed. If there are multiple + versions of ⟨pkg⟩ installed and ``-hide-all-plugin-packages`` was not + specified, then all other versions will become hidden. ``-plugin-package`` + supports thinning and renaming described in + :ref:`package-thinning-and-renaming`. + + Unlike ``-package``, this option does NOT cause package ⟨pkg⟩ to be linked + into the resulting executable or shared object. + +``-plugin-package-id ⟨pkg-id⟩`` + .. index:: + single: -plugin-package-id + + Exposes a package in the plugin namespace like ``-plugin-package``, but the + package is named by its installed package ID rather than by name. This is a + more robust way to name packages, and can be used to select packages that + would otherwise be shadowed. Cabal passes ``-plugin-package-id`` flags to + GHC. ``-plugin-package-id`` supports thinning and renaming described in + :ref:`package-thinning-and-renaming`. + +``-hide-all-plugin-packages`` + .. index:: + single: -hide-all-plugin-packages + + By default, all exposed packages in the normal, source import + namespace are also available for plugins. This causes those + packages to be hidden by default. + If you use this flag, then any packages with plugins you require + need to be explicitly exposed using + ``-plugin-package`` options. + +To declare a dependency on a plugin, add it to the ``ghc-plugins`` field +in Cabal. You should only put a plugin in ``build-depends`` if you +require compatibility with older versions of Cabal, or also have a source +import on the plugin in question. .. _writing-compiler-plugins: diff --git a/docs/users_guide/packages.rst b/docs/users_guide/packages.rst index b9e017ac2a..1eb7c31fc9 100644 --- a/docs/users_guide/packages.rst +++ b/docs/users_guide/packages.rst @@ -176,7 +176,7 @@ The GHC command line options that control packages are: ``-hide-all-packages`` .. index:: - single: -hide-package + single: -hide-all-packages Ignore the exposed flag on installed packages, and hide them all by default. If you use this flag, then any packages you require diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 986c119783..4fcbe6d7fe 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -2377,6 +2377,13 @@ setOptions wds = -- then, dynamic flags newDynFlags False minus_opts +packageFlagsChanged :: DynFlags -> DynFlags -> Bool +packageFlagsChanged idflags1 idflags0 = + packageFlags idflags1 /= packageFlags idflags0 || + ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 || + pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 || + trustFlags idflags1 /= trustFlags idflags0 + newDynFlags :: Bool -> [String] -> GHCi () newDynFlags interactive_only minus_opts = do let lopts = map noLoc minus_opts @@ -2390,8 +2397,7 @@ newDynFlags interactive_only minus_opts = do $ "Some flags have not been recognized: " ++ (concat . intersperse ", " $ map unLoc leftovers)) - when (interactive_only && - packageFlags idflags1 /= packageFlags idflags0) $ do + when (interactive_only && packageFlagsChanged idflags1 idflags0) $ do liftIO $ hPutStrLn stderr "cannot set package flags with :seti; use :set" GHC.setInteractiveDynFlags idflags1 installInteractivePrint (interactivePrint idflags1) False @@ -2405,7 +2411,7 @@ newDynFlags interactive_only minus_opts = do -- the new packages. hsc_env <- GHC.getSession let dflags2 = hsc_dflags hsc_env - when (packageFlags dflags2 /= packageFlags dflags0) $ do + when (packageFlagsChanged dflags2 dflags0) $ do when (verbosity dflags2 > 0) $ liftIO . putStrLn $ "package flags have changed, resetting and loading new packages..." diff --git a/testsuite/.gitignore b/testsuite/.gitignore index ef3e720e24..2886400681 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1243,6 +1243,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/plugins/plugins06 /tests/plugins/plugins07 /tests/plugins/rule-defining-plugin/pkg.T10420/ +/tests/plugins/rule-defining-plugin/pkg.T11244/ /tests/plugins/rule-defining-plugin/pkg.plugins07/ /tests/plugins/simple-plugin/dist/ /tests/plugins/simple-plugin/install/ diff --git a/testsuite/tests/ghc-api/T9595.hs b/testsuite/tests/ghc-api/T9595.hs index d4e01d070c..0f71d7700b 100644 --- a/testsuite/tests/ghc-api/T9595.hs +++ b/testsuite/tests/ghc-api/T9595.hs @@ -18,7 +18,8 @@ main = _ <- runGhc (Just libdir) $ do dflags <- getSessionDynFlags setSessionDynFlags (dflags { - packageFlags = [ExposePackage (PackageArg "ghc") + packageFlags = [ExposePackage "-package ghc" + (PackageArg "ghc") (ModRenaming True [])] }) dflags <- getSessionDynFlags diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile index c12c33c9c7..28d3ae8aa7 100644 --- a/testsuite/tests/plugins/Makefile +++ b/testsuite/tests/plugins/Makefile @@ -2,19 +2,24 @@ TOP=../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk +# Each of the tests also exercise the various ways to bring plugins into scope + +# -hide-all-plugin-packages + -plugin-package .PHONY: plugins01 plugins01: - "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins01.hs -package-db simple-plugin/pkg.plugins01/local.package.conf -fplugin Simple.Plugin -fplugin-opt Simple.Plugin:Irrelevant_Option -package simple-plugin + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins01.hs -package-db simple-plugin/pkg.plugins01/local.package.conf -fplugin Simple.Plugin -fplugin-opt Simple.Plugin:Irrelevant_Option -hide-all-plugin-packages -plugin-package simple-plugin ./plugins01 +# -hide-all-packages + -plugin-package .PHONY: plugins07 plugins07: - "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O plugins07.hs -package-db rule-defining-plugin/pkg.plugins07/local.package.conf -package rule-defining-plugin -fplugin=RuleDefiningPlugin + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O plugins07.hs -package-db rule-defining-plugin/pkg.plugins07/local.package.conf -hide-all-packages -package base -plugin-package rule-defining-plugin -fplugin=RuleDefiningPlugin ./plugins07 +# -package (should work for backwards compatibility) .PHONY: T10420 T10420: - "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O T10420.hs -package-db rule-defining-plugin/pkg.T10420/local.package.conf -package rule-defining-plugin + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O T10420.hs -package-db rule-defining-plugin/pkg.T10420/local.package.conf -hide-all-packages -package base -package rule-defining-plugin ./T10420 .PHONY: T10294 @@ -31,3 +36,8 @@ frontend01: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -Wall -package ghc -c FrontendPlugin.hs "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --frontend FrontendPlugin -ffrontend-opt foobar frontend01 ./frontend01 + +# -hide-all-plugin-packages + -package (this should not work!) +.PHONY: T11244 +T11244: + ! "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O T11244.hs -package-db rule-defining-plugin/pkg.T11244/local.package.conf -hide-all-plugin-packages -package rule-defining-plugin -fplugin=RuleDefiningPlugin diff --git a/testsuite/tests/plugins/T11244.hs b/testsuite/tests/plugins/T11244.hs new file mode 100644 index 0000000000..dba99b0017 --- /dev/null +++ b/testsuite/tests/plugins/T11244.hs @@ -0,0 +1 @@ +module ShouldFail where diff --git a/testsuite/tests/plugins/T11244.stderr b/testsuite/tests/plugins/T11244.stderr new file mode 100644 index 0000000000..30c8c5b127 --- /dev/null +++ b/testsuite/tests/plugins/T11244.stderr @@ -0,0 +1,3 @@ +<command line>: Could not find module ‘RuleDefiningPlugin’ +It is a member of the hidden package ‘rule-defining-plugin-0.1’. +Use -v to see a list of the files searched for. diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 1f9ec3b3b8..7bbbe1c4cd 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -68,3 +68,9 @@ test('frontend01', 'frontend01', 'frontend01.o', 'frontend01.hi']), unless(have_dynamic(), expect_broken(10301))], run_command, ['$MAKE -s --no-print-directory frontend01']) + +test('T11244', + [pre_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin package.T11244'), + clean_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin clean.T11244')], + run_command, + ['$MAKE -s --no-print-directory T11244']) |