diff options
Diffstat (limited to 'compiler/GHC/Driver')
| -rw-r--r-- | compiler/GHC/Driver/Flags.hs | 5 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Main.hs | 37 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Session.hs | 3 |
3 files changed, 43 insertions, 2 deletions
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs index 05733c88e4..d7f72fcf2e 100644 --- a/compiler/GHC/Driver/Flags.hs +++ b/compiler/GHC/Driver/Flags.hs @@ -536,6 +536,7 @@ data WarningFlag = | Opt_WarnMissingKindSignatures -- Since 9.2 | Opt_WarnMissingExportedPatternSynonymSignatures -- since 9.2 | Opt_WarnRedundantStrictnessFlags -- Since 9.4 + | Opt_WarnUnicodeBidirectionalFormatCharacters -- Since 9.0.2 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -635,6 +636,7 @@ warnFlagNames wflag = case wflag of Opt_WarnOperatorWhitespace -> "operator-whitespace" :| [] Opt_WarnImplicitLift -> "implicit-lift" :| [] Opt_WarnMissingExportedPatternSynonymSignatures -> "missing-exported-pattern-synonym-signatures" :| [] + Opt_WarnUnicodeBidirectionalFormatCharacters -> "unicode-bidirectional-format-characters" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options @@ -725,7 +727,8 @@ standardWarnings -- see Note [Documenting warning flags] Opt_WarnSpaceAfterBang, Opt_WarnNonCanonicalMonadInstances, Opt_WarnNonCanonicalMonoidInstances, - Opt_WarnOperatorWhitespaceExtConflict + Opt_WarnOperatorWhitespaceExtConflict, + Opt_WarnUnicodeBidirectionalFormatCharacters ] -- | Things you get with -W diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 80d50a4589..26647df369 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -239,6 +239,7 @@ import GHC.Data.Maybe import GHC.Driver.Env.KnotVars import GHC.Types.Name.Set (NonCaffySet) import GHC.Driver.GenerateCgIPEStub (generateCgIPEStub) +import Data.List.NonEmpty (NonEmpty ((:|))) {- ********************************************************************** @@ -411,6 +412,17 @@ hscParse' mod_summary Nothing -> liftIO $ hGetStringBuffer src_filename let loc = mkRealSrcLoc (mkFastString src_filename) 1 1 + + let diag_opts = initDiagOpts dflags + when (wopt Opt_WarnUnicodeBidirectionalFormatCharacters dflags) $ do + case checkBidirectionFormatChars (PsLoc loc (BufPos 0)) buf of + Nothing -> pure () + Just chars@((eloc,chr,_) :| _) -> + let span = mkSrcSpanPs $ mkPsSpan eloc (advancePsLoc eloc chr) + in logDiagnostics $ singleMessage $ + mkPlainMsgEnvelope diag_opts span $ + GhcPsMessage $ PsWarnBidirectionalFormatChars chars + let parseMod | HsigFile == ms_hsc_src mod_summary = parseSignature | otherwise = parseModule @@ -469,9 +481,34 @@ hscParse' mod_summary hsc_env <- getHscEnv withPlugins hsc_env applyPluginAction res +checkBidirectionFormatChars :: PsLoc -> StringBuffer -> Maybe (NonEmpty (PsLoc, Char, String)) +checkBidirectionFormatChars start_loc sb + | containsBidirectionalFormatChar sb = Just $ go start_loc sb + | otherwise = Nothing + where + go :: PsLoc -> StringBuffer -> NonEmpty (PsLoc, Char, String) + go loc sb + | atEnd sb = panic "checkBidirectionFormatChars: no char found" + | otherwise = case nextChar sb of + (chr, sb) + | Just desc <- lookup chr bidirectionalFormatChars -> + (loc, chr, desc) :| go1 (advancePsLoc loc chr) sb + | otherwise -> go (advancePsLoc loc chr) sb + + go1 :: PsLoc -> StringBuffer -> [(PsLoc, Char, String)] + go1 loc sb + | atEnd sb = [] + | otherwise = case nextChar sb of + (chr, sb) + | Just desc <- lookup chr bidirectionalFormatChars -> + (loc, chr, desc) : go1 (advancePsLoc loc chr) sb + | otherwise -> go1 (advancePsLoc loc chr) sb + -- ----------------------------------------------------------------------------- -- | If the renamed source has been kept, extract it. Dump it if requested. + + extract_renamed_stuff :: ModSummary -> TcGblEnv -> Hsc RenamedStuff extract_renamed_stuff mod_summary tc_result = do let rn_info = getRenamedStuff tc_result diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 478a0f7737..67fa5c0103 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -3209,7 +3209,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnOperatorWhitespaceExtConflict, warnSpec Opt_WarnOperatorWhitespace, warnSpec Opt_WarnImplicitLift, - warnSpec Opt_WarnMissingExportedPatternSynonymSignatures + warnSpec Opt_WarnMissingExportedPatternSynonymSignatures, + warnSpec Opt_WarnUnicodeBidirectionalFormatCharacters ] -- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@ |