diff options
Diffstat (limited to 'compiler/GHC/Driver')
-rw-r--r-- | compiler/GHC/Driver/Backpack.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Driver/Flags.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Driver/Pipeline.hs | 9 | ||||
-rw-r--r-- | compiler/GHC/Driver/Pipeline/Execute.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Driver/Pipeline/Phases.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 1 |
6 files changed, 15 insertions, 9 deletions
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs index 43ced2ba13..9c67f1550b 100644 --- a/compiler/GHC/Driver/Backpack.hs +++ b/compiler/GHC/Driver/Backpack.hs @@ -97,7 +97,7 @@ doBackpack [src_filename] = do dflags0 <- getDynFlags let dflags1 = dflags0 let parser_opts1 = initParserOpts dflags1 - src_opts <- liftIO $ getOptionsFromFile parser_opts1 src_filename + (p_warns, src_opts) <- liftIO $ getOptionsFromFile parser_opts1 src_filename (dflags, unhandled_flags, warns) <- liftIO $ parseDynamicFilePragma dflags1 src_opts modifySession (hscSetFlags dflags) logger <- getLogger -- Get the logger after having set the session flags, @@ -105,6 +105,7 @@ doBackpack [src_filename] = do -- Not doing so caused #20396. -- Cribbed from: preprocessFile / GHC.Driver.Pipeline liftIO $ checkProcessArgsResult unhandled_flags + liftIO $ printOrThrowDiagnostics logger (initDiagOpts dflags) (GhcPsMessage <$> p_warns) liftIO $ handleFlagWarnings logger (initDiagOpts dflags) warns -- TODO: Preprocessing not implemented diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs index a2ac1b75f4..671d163ac7 100644 --- a/compiler/GHC/Driver/Flags.hs +++ b/compiler/GHC/Driver/Flags.hs @@ -503,6 +503,7 @@ data WarningFlag = | Opt_WarnIdentities | Opt_WarnTabs | Opt_WarnUnrecognisedPragmas + | Opt_WarnMisplacedPragmas | Opt_WarnDodgyForeignImports | Opt_WarnUnusedDoBind | Opt_WarnWrongDoBind @@ -623,6 +624,7 @@ warnFlagNames wflag = case wflag of Opt_WarnTypedHoles -> "typed-holes" :| [] Opt_WarnPartialTypeSignatures -> "partial-type-signatures" :| [] Opt_WarnUnrecognisedPragmas -> "unrecognised-pragmas" :| [] + Opt_WarnMisplacedPragmas -> "misplaced-pragmas" :| [] Opt_WarnUnsafe -> "unsafe" :| [] Opt_WarnUnsupportedCallingConventions -> "unsupported-calling-conventions" :| [] Opt_WarnUnsupportedLlvmVersion -> "unsupported-llvm-version" :| [] @@ -731,6 +733,7 @@ standardWarnings -- see Note [Documenting warning flags] Opt_WarnDeferredOutOfScopeVariables, Opt_WarnPartialTypeSignatures, Opt_WarnUnrecognisedPragmas, + Opt_WarnMisplacedPragmas, Opt_WarnDuplicateExports, Opt_WarnDerivingDefaults, Opt_WarnOverflowedLiterals, diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index ceb4fa0ae0..02ca6a4b57 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -663,13 +663,13 @@ preprocessPipeline pipe_env hsc_env input_fn = do use (T_Unlit pipe_env hsc_env input_fn) - (dflags1, warns1) <- use (T_FileArgs hsc_env unlit_fn) + (dflags1, p_warns1, warns1) <- use (T_FileArgs hsc_env unlit_fn) let hsc_env1 = hscSetFlags dflags1 hsc_env (cpp_fn, hsc_env2) <- runAfterFlag hsc_env1 (Cpp HsSrcFile) (xopt LangExt.Cpp) (unlit_fn, hsc_env1) $ do cpp_fn <- use (T_Cpp pipe_env hsc_env1 unlit_fn) - (dflags2, _) <- use (T_FileArgs hsc_env1 cpp_fn) + (dflags2, _, _) <- use (T_FileArgs hsc_env1 cpp_fn) let hsc_env2 = hscSetFlags dflags2 hsc_env1 return (cpp_fn, hsc_env2) @@ -677,15 +677,16 @@ preprocessPipeline pipe_env hsc_env input_fn = do pp_fn <- runAfterFlag hsc_env2 (HsPp HsSrcFile) (gopt Opt_Pp) cpp_fn $ use (T_HsPp pipe_env hsc_env2 input_fn cpp_fn) - (dflags3, warns3) + (dflags3, p_warns3, warns3) <- if pp_fn == unlit_fn -- Didn't run any preprocessors so don't need to reparse, would be nicer -- if `T_FileArgs` recognised this. - then return (dflags1, warns1) + then return (dflags1, p_warns1, warns1) else do -- Reparse with original hsc_env so that we don't get duplicated options use (T_FileArgs hsc_env pp_fn) + liftIO (printOrThrowDiagnostics (hsc_logger hsc_env) (initDiagOpts dflags3) (GhcPsMessage <$> p_warns3)) liftIO (handleFlagWarnings (hsc_logger hsc_env) (initDiagOpts dflags3) warns3) return (dflags3, pp_fn) diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs index 8a185bf4ec..61fc86c836 100644 --- a/compiler/GHC/Driver/Pipeline/Execute.hs +++ b/compiler/GHC/Driver/Pipeline/Execute.hs @@ -571,15 +571,15 @@ runUnlitPhase hsc_env input_fn output_fn = do return output_fn -getFileArgs :: HscEnv -> FilePath -> IO ((DynFlags, [Warn])) +getFileArgs :: HscEnv -> FilePath -> IO ((DynFlags, Messages PsMessage, [Warn])) getFileArgs hsc_env input_fn = do let dflags0 = hsc_dflags hsc_env parser_opts = initParserOpts dflags0 - src_opts <- getOptionsFromFile parser_opts input_fn + (warns0, src_opts) <- getOptionsFromFile parser_opts input_fn (dflags1, unhandled_flags, warns) <- parseDynamicFilePragma dflags0 src_opts checkProcessArgsResult unhandled_flags - return (dflags1, warns) + return (dflags1, warns0, warns) runCppPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath runCppPhase hsc_env input_fn output_fn = do diff --git a/compiler/GHC/Driver/Pipeline/Phases.hs b/compiler/GHC/Driver/Pipeline/Phases.hs index d689e1e266..431c9e0b1d 100644 --- a/compiler/GHC/Driver/Pipeline/Phases.hs +++ b/compiler/GHC/Driver/Pipeline/Phases.hs @@ -28,7 +28,7 @@ import GHC.Driver.Phases -- phase if the inputs have been modified. data TPhase res where T_Unlit :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath - T_FileArgs :: HscEnv -> FilePath -> TPhase (DynFlags, [Warn]) + T_FileArgs :: HscEnv -> FilePath -> TPhase (DynFlags, Messages PsMessage, [Warn]) T_Cpp :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath T_HsPp :: PipeEnv -> HscEnv -> FilePath -> FilePath -> TPhase FilePath T_HscRecomp :: PipeEnv -> HscEnv -> FilePath -> HscSource -> TPhase (HscEnv, ModSummary, HscRecompStatus) diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 17090615f8..bf74bac0ab 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -3257,6 +3257,7 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnTypedHoles, warnSpec Opt_WarnPartialTypeSignatures, warnSpec Opt_WarnUnrecognisedPragmas, + warnSpec Opt_WarnMisplacedPragmas, warnSpec' Opt_WarnUnsafe setWarnUnsafe, warnSpec Opt_WarnUnsupportedCallingConventions, warnSpec Opt_WarnUnsupportedLlvmVersion, |