Commit c43cb492 authored by Simon Marlow's avatar Simon Marlow

Disallow package flags in OPTIONS_GHC pragmas (#2499)

parent f7d457cd
......@@ -665,7 +665,7 @@ runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
= do let dflags0 = hsc_dflags hsc_env
src_opts <- liftIO $ getOptionsFromFile dflags0 input_fn
(dflags, unhandled_flags, warns)
<- liftIO $ parseDynamicFlags dflags0 src_opts
<- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts
liftIO $ handleFlagWarnings dflags warns -- XXX: may exit the program
liftIO $ checkProcessArgsResult unhandled_flags -- XXX: may throw program error
......
......@@ -38,6 +38,7 @@ module DynFlags (
-- ** Parsing DynFlags
parseDynamicFlags,
parseDynamicNoPackageFlags,
allFlags,
supportedLanguages, languageOptions,
......@@ -1225,20 +1226,6 @@ dynamic_flags = [
, Flag "no-recomp" (NoArg (setDynFlag Opt_ForceRecomp))
(Deprecated "Use -fforce-recomp instead")
------- Packages ----------------------------------------------------
, Flag "package-conf" (HasArg extraPkgConf_) Supported
, Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
Supported
, Flag "package-name" (HasArg (upd . setPackageName)) Supported
, Flag "package" (HasArg exposePackage) Supported
, Flag "hide-package" (HasArg hidePackage) Supported
, Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
Supported
, Flag "ignore-package" (HasArg ignorePackage)
Supported
, Flag "syslib" (HasArg exposePackage)
(Deprecated "Use -package instead")
------ HsCpp opts ---------------------------------------------------
, Flag "D" (AnySuffix (upd . addOptP)) Supported
, Flag "U" (AnySuffix (upd . addOptP)) Supported
......@@ -1474,6 +1461,23 @@ dynamic_flags = [
++ map (mkFlag True "X" setDynFlag ) xFlags
++ map (mkFlag False "XNo" unSetDynFlag) xFlags
package_flags :: [Flag DynP]
package_flags = [
------- Packages ----------------------------------------------------
Flag "package-conf" (HasArg extraPkgConf_) Supported
, Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
Supported
, Flag "package-name" (HasArg (upd . setPackageName)) Supported
, Flag "package" (HasArg exposePackage) Supported
, Flag "hide-package" (HasArg hidePackage) Supported
, Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
Supported
, Flag "ignore-package" (HasArg ignorePackage)
Supported
, Flag "syslib" (HasArg exposePackage)
(Deprecated "Use -package instead")
]
mkFlag :: Bool -- ^ True <=> it should be turned on
-> String -- ^ The flag prefix
-> (DynFlag -> DynP ())
......@@ -1712,7 +1716,7 @@ glasgowExtsFlags = [
-- -----------------------------------------------------------------------------
-- Parsing the dynamic flags.
-- | Parse dynamic flags from a list of command line argument. Returns the
-- | Parse dynamic flags from a list of command line arguments. Returns the
-- the parsed 'DynFlags', the left-over arguments, and a list of warnings.
-- Throws a 'UsageError' if errors occurred during parsing (such as unknown
-- flags or missing arguments).
......@@ -1721,7 +1725,21 @@ parseDynamicFlags :: Monad m =>
-> m (DynFlags, [Located String], [Located String])
-- ^ Updated 'DynFlags', left-over arguments, and
-- list of warnings.
parseDynamicFlags dflags args = do
parseDynamicFlags dflags args = parseDynamicFlags_ dflags args True
-- | Like 'parseDynamicFlags' but does not allow the package flags (-package,
-- -hide-package, -ignore-package, -hide-all-packages, -package-conf).
parseDynamicNoPackageFlags :: Monad m =>
DynFlags -> [Located String]
-> m (DynFlags, [Located String], [Located String])
-- ^ Updated 'DynFlags', left-over arguments, and
-- list of warnings.
parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False
parseDynamicFlags_ :: Monad m =>
DynFlags -> [Located String] -> Bool
-> m (DynFlags, [Located String], [Located String])
parseDynamicFlags_ dflags args pkg_flags = do
-- XXX Legacy support code
-- We used to accept things like
-- optdep-f -optdepdepend
......@@ -1733,8 +1751,12 @@ parseDynamicFlags dflags args = do
f (x : xs) = x : f xs
f xs = xs
args' = f args
flag_spec | pkg_flags = dynamic_flags ++ package_flags
| otherwise = dynamic_flags
let ((leftover, errs, warns), dflags')
= runCmdLine (processArgs dynamic_flags args') dflags
= runCmdLine (processArgs flag_spec args') dflags
when (not (null errs)) $ ghcError $ errorsToGhcException errs
return (dflags', leftover, warns)
......
......@@ -2188,7 +2188,7 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
local_opts = getOptions dflags buf src_fn
--
(dflags', leftovers, warns)
<- parseDynamicFlags dflags local_opts
<- parseDynamicNoPackageFlags dflags local_opts
liftIO $ checkProcessArgsResult leftovers -- XXX: throws exceptions
liftIO $ handleFlagWarnings dflags' warns -- XXX: throws exceptions
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment