Add warnings for file header pragmas that appear in the body of a module (#20385)

Once we are done parsing the header of a module to obtain the options, we
look through the rest of the tokens in order to determine if they contain any
misplaced file header pragmas that would usually be ignored, potentially
resulting in bad error messages.

The warnings are reported immediately so that later errors don't shadow
over potentially helpful warnings.

Metric Increase:
  T13719

25 files changed, 156 insertions, 28 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,
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs
index e69aabc0db..3e83958c88 100644
--- a/compiler/GHC/Parser/Errors/Ppr.hs
+++ b/compiler/GHC/Parser/Errors/Ppr.hs
@@ -107,6 +107,8 @@ instance Diagnostic PsMessage where
           $$ text "deprecated in the future."
     PsWarnUnrecognisedPragma
       -> mkSimpleDecorated $ text "Unrecognised pragma"
+    PsWarnMisplacedPragma prag
+      -> mkSimpleDecorated $ text "Misplaced" <+> pprFileHeaderPragmaType prag <+> text "pragma"
     PsWarnImportPreQualified
       -> mkSimpleDecorated $
             text "Found" <+> quotes (text "qualified")
@@ -506,6 +508,7 @@ instance Diagnostic PsMessage where
     PsWarnStarBinder                              -> WarningWithFlag Opt_WarnStarBinder
     PsWarnStarIsType                              -> WarningWithFlag Opt_WarnStarIsType
     PsWarnUnrecognisedPragma                      -> WarningWithFlag Opt_WarnUnrecognisedPragmas
+    PsWarnMisplacedPragma{}                       -> WarningWithFlag Opt_WarnMisplacedPragmas
     PsWarnImportPreQualified                      -> WarningWithFlag Opt_WarnPrepositiveQualifiedModule
     PsErrLexer{}                                  -> ErrorWithoutFlag
     PsErrCmmLexer                                 -> ErrorWithoutFlag
@@ -621,6 +624,7 @@ instance Diagnostic PsMessage where
     PsWarnStarBinder                              -> [SuggestQualifyStarOperator]
     PsWarnStarIsType                              -> [SuggestUseTypeFromDataKind Nothing]
     PsWarnUnrecognisedPragma                      -> noHints
+    PsWarnMisplacedPragma{}                       -> [SuggestPlacePragmaInHeader]
     PsWarnImportPreQualified                      -> [ SuggestQualifiedAfterModuleName
                                                      , suggestExtension LangExt.ImportQualifiedPost]
     PsErrLexer{}                                  -> noHints
@@ -835,3 +839,9 @@ parse_error_in_pat = text "Parse error in pattern:"
 forallSym :: Bool -> SDoc
 forallSym True  = text "∀"
 forallSym False = text "forall"
+
+pprFileHeaderPragmaType :: FileHeaderPragmaType -> SDoc
+pprFileHeaderPragmaType OptionsPrag    = text "OPTIONS"
+pprFileHeaderPragmaType IncludePrag    = text "INCLUDE"
+pprFileHeaderPragmaType LanguagePrag   = text "LANGUAGE"
+pprFileHeaderPragmaType DocOptionsPrag = text "OPTIONS_HADDOCK"
diff --git a/compiler/GHC/Parser/Errors/Types.hs b/compiler/GHC/Parser/Errors/Types.hs
index f9a1b4661d..d2ff9c242d 100644
--- a/compiler/GHC/Parser/Errors/Types.hs
+++ b/compiler/GHC/Parser/Errors/Types.hs
@@ -119,6 +119,7 @@ data PsMessage
 
    -- | Unrecognised pragma
    | PsWarnUnrecognisedPragma
+   | PsWarnMisplacedPragma !FileHeaderPragmaType
 
    -- | Invalid Haddock comment position
    | PsWarnHaddockInvalidPos
@@ -550,3 +551,10 @@ data CmmParserError
 data TransLayoutReason
    = TransLayout_Where -- ^ "`where' clause at the same depth as implicit layout block"
    | TransLayout_Pipe  -- ^ "`|' at the same depth as implicit layout block")
+
+
+data FileHeaderPragmaType
+  = OptionsPrag
+  | IncludePrag
+  | LanguagePrag
+  | DocOptionsPrag
diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs
index 87f20b5c9c..2a31d21cfc 100644
--- a/compiler/GHC/Parser/Header.hs
+++ b/compiler/GHC/Parser/Header.hs
@@ -22,6 +22,8 @@ where
 
 import GHC.Prelude
 
+import GHC.Data.Bag
+
 import GHC.Driver.Errors.Types -- Unfortunate, needed due to the fact we throw exceptions!
 
 import GHC.Parser.Errors.Types
@@ -163,15 +165,17 @@ mkPrelImports this_mod loc implicit_prelude import_decls
 -- Throws a 'SourceError' if flag parsing fails (including unsupported flags.)
 getOptionsFromFile :: ParserOpts
                    -> FilePath            -- ^ Input file
-                   -> IO [Located String] -- ^ Parsed options, if any.
+                   -> IO (Messages PsMessage, [Located String]) -- ^ Parsed options, if any.
 getOptionsFromFile opts filename
     = Exception.bracket
               (openBinaryFile filename ReadMode)
               (hClose)
               (\handle -> do
-                  opts <- fmap (getOptions' opts)
+                  (warns, opts) <- fmap (getOptions' opts)
                                (lazyGetToks opts' filename handle)
-                  seqList opts $ return opts)
+                  seqList opts
+                    $ seqList (bagToList $ getMessages warns)
+                    $ return (warns, opts))
     where -- We don't need to get haddock doc tokens when we're just
           -- getting the options from pragmas, and lazily lexing them
           -- correctly is a little tricky: If there is "\n" or "\n-"
@@ -243,7 +247,7 @@ getToks popts filename buf = lexAll pstate
 getOptions :: ParserOpts
            -> StringBuffer -- ^ Input Buffer
            -> FilePath     -- ^ Source filename.  Used for location info.
-           -> [Located String] -- ^ Parsed options.
+           -> (Messages PsMessage,[Located String]) -- ^ warnings and parsed options.
 getOptions opts buf filename
     = getOptions' opts (getToks opts filename buf)
 
@@ -253,7 +257,7 @@ getOptions opts buf filename
 -- CPP, so we can't use the same trick as 'getImports'.
 getOptions' :: ParserOpts
             -> [Located Token]      -- Input buffer
-            -> [Located String]     -- Options.
+            -> (Messages PsMessage,[Located String])     -- Options.
 getOptions' opts toks
     = parseToks toks
     where
@@ -263,7 +267,7 @@ getOptions' opts toks
               = case toArgs starting_loc str of
                   Left _err -> optionsParseError str $   -- #15053
                                  combineSrcSpans (getLoc open) (getLoc close)
-                  Right args -> args ++ parseToks xs
+                  Right args -> fmap (args ++) (parseToks xs)
             where
               src_span      = getLoc open
               real_src_span = expectJust "getOptions'" (srcSpanToRealSrcSpan src_span)
@@ -271,22 +275,24 @@ getOptions' opts toks
           parseToks (open:close:xs)
               | ITinclude_prag str <- unLoc open
               , ITclose_prag       <- unLoc close
-              = map (L (getLoc open)) ["-#include",removeSpaces str] ++
-                parseToks xs
+              = fmap (map (L (getLoc open)) ["-#include",removeSpaces str] ++)
+                     (parseToks xs)
           parseToks (open:close:xs)
               | ITdocOptions str _ <- unLoc open
               , ITclose_prag       <- unLoc close
-              = map (L (getLoc open)) ["-haddock-opts", removeSpaces str]
-                ++ parseToks xs
+              = fmap (map (L (getLoc open)) ["-haddock-opts", removeSpaces str] ++)
+                     (parseToks xs)
           parseToks (open:xs)
               | ITlanguage_prag <- unLoc open
               = parseLanguage xs
           parseToks (comment:xs) -- Skip over comments
               | isComment (unLoc comment)
               = parseToks xs
-          parseToks _ = []
+          -- At the end of the header, warn about all the misplaced pragmas
+          parseToks xs = (unionManyMessages $ mapMaybe mkMessage xs ,[])
+
           parseLanguage ((L loc (ITconid fs)):rest)
-              = checkExtension opts (L loc fs) :
+              = fmap (checkExtension opts (L loc fs) :) $
                 case rest of
                   (L _loc ITcomma):more -> parseLanguage more
                   (L _loc ITclose_prag):more -> parseToks more
@@ -297,6 +303,20 @@ getOptions' opts toks
           parseLanguage []
               = panic "getOptions'.parseLanguage(2) went past eof token"
 
+          -- Warn for all the misplaced pragmas
+          mkMessage :: Located Token -> Maybe (Messages PsMessage)
+          mkMessage (L loc token)
+            | IToptions_prag _ <- token
+            = Just (singleMessage $ mkPlainMsgEnvelope diag_opts loc (PsWarnMisplacedPragma OptionsPrag))
+            | ITinclude_prag _ <- token
+            = Just (singleMessage $ mkPlainMsgEnvelope diag_opts loc (PsWarnMisplacedPragma IncludePrag))
+            | ITdocOptions _ _ <- token
+            = Just (singleMessage $ mkPlainMsgEnvelope diag_opts loc (PsWarnMisplacedPragma DocOptionsPrag))
+            | ITlanguage_prag <- token
+            = Just (singleMessage $ mkPlainMsgEnvelope diag_opts loc (PsWarnMisplacedPragma LanguagePrag))
+            | otherwise = Nothing
+            where diag_opts = pDiagOpts opts
+
           isComment :: Token -> Bool
           isComment c =
             case c of
diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs
index a3b40dbf2f..cbdb8d5321 100644
--- a/compiler/GHC/Types/Hint.hs
+++ b/compiler/GHC/Types/Hint.hs
@@ -394,6 +394,11 @@ data GhcHint
     -}
   | SuggestImportingDataCon
 
+  {- Found a pragma in the body of a module, suggest
+     placing it in the header
+  -}
+  | SuggestPlacePragmaInHeader
+
 -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated
 -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
 -- to instantiate a particular signature, where the first argument is
diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs
index ee1060f0ff..fbaa2a8842 100644
--- a/compiler/GHC/Types/Hint/Ppr.hs
+++ b/compiler/GHC/Types/Hint/Ppr.hs
@@ -194,6 +194,9 @@ instance Outputable GhcHint where
       -> pprImportSuggestion import_suggestion
     SuggestImportingDataCon
       -> text "Import the data constructor to bring it into scope"
+    SuggestPlacePragmaInHeader
+      -> text "Perhaps you meant to place it in the module header?"
+      $$ text "The module header is the section at the top of the file, before the" <+> quotes (text "module") <+> text "keyword"
 
 perhapsAsPat :: SDoc
 perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 13c04f7d98..60598eb623 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -456,6 +456,20 @@ of ``-W(no-)*``.
     recognises pragmas known to be used by other tools, e.g.
     ``OPTIONS_HUGS`` and ``DERIVE``.
 
+.. ghc-flag:: -Wmisplaced-pragmas
+    :shortdesc: warn about uses of file header pragmas in the module body
+    :type: dynamic
+    :reverse: -Wno-misplaced-pragmas
+    :category:
+
+    :since: 9.4
+
+    :default: on
+
+    Warn when a pragma that should only appear in the header of a module,
+    such as a `LANGUAGE` or `OPTIONS_GHC` pragma, appears in the body of
+    the module instead.
+
 .. ghc-flag:: -Wmissed-specialisations
     :shortdesc: warn when specialisation of an imported, overloaded function
         fails.
diff --git a/testsuite/tests/ffi/should_compile/T11983.hs b/testsuite/tests/ffi/should_compile/T11983.hs
index 162d2411fc..273aee980e 100644
--- a/testsuite/tests/ffi/should_compile/T11983.hs
+++ b/testsuite/tests/ffi/should_compile/T11983.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module T11983 where
 
-{-# INCLUDE T11983.h #-}
+
 
 import Foreign.Ptr
 
diff --git a/testsuite/tests/ghc-api/T10942.hs b/testsuite/tests/ghc-api/T10942.hs
index 06cdcd62e4..a37d279c3a 100644
--- a/testsuite/tests/ghc-api/T10942.hs
+++ b/testsuite/tests/ghc-api/T10942.hs
@@ -21,4 +21,4 @@ main = do
         parser_opts = initParserOpts dflags'
     setSessionDynFlags dflags'
     stringBuffer <- liftIO $ hGetStringBuffer filename
-    liftIO $ print (map unLoc (getOptions parser_opts stringBuffer filename))
+    liftIO $ print (map unLoc (snd $ getOptions parser_opts stringBuffer filename))
diff --git a/testsuite/tests/parser/should_compile/T20385.hs b/testsuite/tests/parser/should_compile/T20385.hs
new file mode 100644
index 0000000000..c51748d5df
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T20385.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecursiveDo #-}
+
+main = pure ()
+
+foo :: forall a. a -> a
+foo x = mdo x
diff --git a/testsuite/tests/parser/should_compile/T20385S.hs b/testsuite/tests/parser/should_compile/T20385S.hs
new file mode 100644
index 0000000000..e9f62260eb
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T20385S.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecursiveDo #-}
+module Main where
+
+main = pure ()
+
+foo :: forall a. a -> a
+foo x = mdo (x :: a)
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index 5412557d10..9a539ddb98 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -185,3 +185,5 @@ test('T20846',    normal, compile, ['-dsuppress-uniques -ddump-parsed-ast'])
 
 test('T20551', normal, compile, [''])
 test('OpaqueParseWarn1', normal, compile, [''])
+test('T20385', normal, compile, [''])
+test('T20385S', normal, compile, [''])
diff --git a/testsuite/tests/parser/should_fail/T20385A.hs b/testsuite/tests/parser/should_fail/T20385A.hs
new file mode 100644
index 0000000000..6f657591b1
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T20385A.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+import Prelude
+
+{-# LANGUAGE RecursiveDo #-}
+
+main = pure ()
+
+foo :: forall a. a -> a
+foo x = mdo x
diff --git a/testsuite/tests/parser/should_fail/T20385A.stderr b/testsuite/tests/parser/should_fail/T20385A.stderr
new file mode 100644
index 0000000000..5a0bbc14e4
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T20385A.stderr
@@ -0,0 +1,12 @@
+
+T20385A.hs:5:1: warning: [-Wmisplaced-pragmas (in -Wdefault)]
+    Misplaced LANGUAGE pragma
+    Suggested fix:
+      Perhaps you meant to place it in the module header?
+      The module header is the section at the top of the file, before the ‘module’ keyword
+
+T20385A.hs:10:9: error:
+    Variable not in scope: mdo :: a -> a
+    Suggested fixes:
+      • Perhaps use ‘mod’ (imported from Prelude)
+      • Perhaps you intended to use RecursiveDo
diff --git a/testsuite/tests/parser/should_fail/T20385B.hs b/testsuite/tests/parser/should_fail/T20385B.hs
new file mode 100644
index 0000000000..80044ec505
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T20385B.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Main where
+
+import Prelude
+
+{-# LANGUAGE RecursiveDo #-}
+
+main = pure ()
+
+foo :: forall a. a -> a
+foo x = mdo x
diff --git a/testsuite/tests/parser/should_fail/T20385B.stderr b/testsuite/tests/parser/should_fail/T20385B.stderr
new file mode 100644
index 0000000000..f854e2be1a
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T20385B.stderr
@@ -0,0 +1,12 @@
+
+T20385B.hs:6:1: warning: [-Wmisplaced-pragmas (in -Wdefault)]
+    Misplaced LANGUAGE pragma
+    Suggested fix:
+      Perhaps you meant to place it in the module header?
+      The module header is the section at the top of the file, before the ‘module’ keyword
+
+T20385B.hs:11:9: error:
+    Variable not in scope: mdo :: a -> a
+    Suggested fixes:
+      • Perhaps use ‘mod’ (imported from Prelude)
+      • Perhaps you intended to use RecursiveDo
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index 1d90ab407e..253d9bcff2 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -205,3 +205,5 @@ test('OpaqueParseFail1', normal, compile_fail, [''])
 test('OpaqueParseFail2', normal, compile_fail, [''])
 test('OpaqueParseFail3', normal, compile_fail, [''])
 test('OpaqueParseFail4', normal, compile_fail, [''])
+test('T20385A', normal, compile_fail, [''])
+test('T20385B', normal, compile_fail, [''])
diff --git a/testsuite/tests/rts/T12031/ExternBug.hs b/testsuite/tests/rts/T12031/ExternBug.hs
index 5c28aede00..3e420b6646 100644
--- a/testsuite/tests/rts/T12031/ExternBug.hs
+++ b/testsuite/tests/rts/T12031/ExternBug.hs
@@ -3,7 +3,5 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module ExternBug (bar) where
 
-{-# INCLUDE foo.h #-}
-
 foreign import ccall "bar"
   bar :: IO ()
diff --git a/testsuite/tests/stranal/should_compile/str001.hs b/testsuite/tests/stranal/should_compile/str001.hs
index 6d27a923fd..332fa1d56c 100644
--- a/testsuite/tests/stranal/should_compile/str001.hs
+++ b/testsuite/tests/stranal/should_compile/str001.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE DatatypeContexts #-}
+{-# OPTIONS -O #-}
 module ShouldSucceed where
 
-{-# OPTIONS -O #-}
 
 newtype Num a => Point2 a     = Point2 (a,a)
 
diff --git a/utils/check-exact/Parsers.hs b/utils/check-exact/Parsers.hs
index cff37bf309..b592a4cee4 100644
--- a/utils/check-exact/Parsers.hs
+++ b/utils/check-exact/Parsers.hs
@@ -305,7 +305,7 @@ initDynFlags :: GHC.GhcMonad m => FilePath -> m GHC.DynFlags
 initDynFlags file = do
   dflags0         <- GHC.getSessionDynFlags
   let parser_opts0 = GHC.initParserOpts dflags0
-  src_opts        <- GHC.liftIO $ GHC.getOptionsFromFile parser_opts0 file
+  (_, src_opts)   <- GHC.liftIO $ GHC.getOptionsFromFile parser_opts0 file
   (dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 src_opts
   -- Turn this on last to avoid T10942
   let dflags2 = dflags1 `GHC.gopt_set` GHC.Opt_KeepRawTokenStream
@@ -332,7 +332,7 @@ initDynFlagsPure fp s = do
   -- no reason to use it.
   dflags0 <- GHC.getSessionDynFlags
   let parser_opts0 = GHC.initParserOpts dflags0
-  let pragmaInfo = GHC.getOptions parser_opts0 (GHC.stringToStringBuffer $ s) fp
+  let (_, pragmaInfo) = GHC.getOptions parser_opts0 (GHC.stringToStringBuffer $ s) fp
   (dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 pragmaInfo
   -- Turn this on last to avoid T10942
   let dflags2 = dflags1 `GHC.gopt_set` GHC.Opt_KeepRawTokenStream