summaryrefslogtreecommitdiff
path: root/compiler/GHC/Driver
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Driver')
-rw-r--r--compiler/GHC/Driver/Backpack.hs3
-rw-r--r--compiler/GHC/Driver/Flags.hs3
-rw-r--r--compiler/GHC/Driver/Pipeline.hs9
-rw-r--r--compiler/GHC/Driver/Pipeline/Execute.hs6
-rw-r--r--compiler/GHC/Driver/Pipeline/Phases.hs2
-rw-r--r--compiler/GHC/Driver/Session.hs1
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 415bb5e38f..d8b9bfa8af 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 97eeb58260..baf4071d51 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 0be53034f3..f03d175549 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3256,6 +3256,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,
View Lorry Controller Status