diff options
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 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, diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs index 4f649d9190..915fd1d4a7 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") @@ -501,6 +503,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 @@ -615,6 +618,7 @@ instance Diagnostic PsMessage where PsWarnStarBinder -> [SuggestQualifyStarOperator] PsWarnStarIsType -> [SuggestUseTypeFromDataKind Nothing] PsWarnUnrecognisedPragma -> noHints + PsWarnMisplacedPragma{} -> [SuggestPlacePragmaInHeader] PsWarnImportPreQualified -> [ SuggestQualifiedAfterModuleName , suggestExtension LangExt.ImportQualifiedPost] PsErrLexer{} -> noHints @@ -828,3 +832,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 d99f789154..2b7854f47e 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 @@ -547,3 +548,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 6304b1d7fd..b964b18914 100644 --- a/compiler/GHC/Types/Hint.hs +++ b/compiler/GHC/Types/Hint.hs @@ -391,6 +391,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 5ed31571b0..321c87d56b 100644 --- a/compiler/GHC/Types/Hint/Ppr.hs +++ b/compiler/GHC/Types/Hint/Ppr.hs @@ -181,6 +181,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 9eaf63ed80..cb95ffb263 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 |