summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Driver/Config/Diagnostic.hs5
-rw-r--r--compiler/GHC/Driver/Flags.hs3
-rw-r--r--compiler/GHC/Driver/Make.hs1
-rw-r--r--compiler/GHC/Driver/Session.hs7
-rw-r--r--compiler/GHC/Tc/Errors/Ppr.hs21
-rw-r--r--docs/users_guide/using.rst12
-rw-r--r--testsuite/tests/driver/T21722.hs6
-rw-r--r--testsuite/tests/driver/T21722.stderr5
-rw-r--r--testsuite/tests/driver/all.T1
9 files changed, 51 insertions, 10 deletions
diff --git a/compiler/GHC/Driver/Config/Diagnostic.hs b/compiler/GHC/Driver/Config/Diagnostic.hs
index e8bf0f5926..3a590abc9f 100644
--- a/compiler/GHC/Driver/Config/Diagnostic.hs
+++ b/compiler/GHC/Driver/Config/Diagnostic.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeApplications #-}
+
-- | Functions for initialising error message printing configuration from the
-- GHC session flags.
module GHC.Driver.Config.Diagnostic
@@ -21,6 +21,7 @@ import GHC.Driver.Errors.Ppr ()
import GHC.Tc.Errors.Types
import GHC.HsToCore.Errors.Types
import GHC.Types.Error
+import GHC.Tc.Errors.Ppr
-- | Initialise the general configuration for printing diagnostic messages
-- For example, this configuration controls things like whether warnings are
@@ -47,7 +48,7 @@ initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage
initPsMessageOpts _ = NoDiagnosticOpts
initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage
-initTcMessageOpts _ = NoDiagnosticOpts
+initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags }
initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage
initDsMessageOpts _ = NoDiagnosticOpts
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index 83d87b6898..0651e1c475 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -427,6 +427,9 @@ data GeneralFlag
| Opt_SuppressTimestamps -- ^ Suppress timestamps in dumps
| Opt_SuppressCoreSizes -- ^ Suppress per binding Core size stats in dumps
+ -- Error message suppression
+ | Opt_ShowErrorContext
+
-- temporary flags
| Opt_AutoLinkPackages
| Opt_ImplicitImportQualified
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 68a925f901..ff2b73eea3 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -4,7 +4,6 @@
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# LANGUAGE FlexibleContexts #-}
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index cf6a5da5e3..836ad88005 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3508,7 +3508,8 @@ fFlagsDeps = [
(\turn_on -> updM (\dflags -> do
unless (platformOS (targetPlatform dflags) == OSDarwin && turn_on)
(addWarn "-compact-unwind is only implemented by the darwin platform. Ignoring.")
- return dflags))
+ return dflags)),
+ flagSpec "show-error-context" Opt_ShowErrorContext
]
++ fHoleFlags
@@ -3802,7 +3803,9 @@ defaultFlags settings
Opt_VersionMacros,
Opt_RPath,
Opt_DumpWithWays,
- Opt_CompactUnwind
+ Opt_CompactUnwind,
+ Opt_ShowErrorContext
+
]
++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 993b62a7ea..2842362a8f 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -18,6 +18,7 @@ module GHC.Tc.Errors.Ppr
, withHsDocContext
, pprHsDocContext
, inHsDocContext
+ , TcRnMessageOpts(..)
)
where
@@ -96,16 +97,25 @@ import Data.Ord ( comparing )
import Data.Bifunctor
import GHC.Types.Name.Env
+data TcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext :: !Bool -- ^ Whether we show the error context or not
+ }
+
+defaultTcRnMessageOpts :: TcRnMessageOpts
+defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext = True }
+
+
instance Diagnostic TcRnMessage where
- type DiagnosticOpts TcRnMessage = NoDiagnosticOpts
- defaultDiagnosticOpts = NoDiagnosticOpts
+ type DiagnosticOpts TcRnMessage = TcRnMessageOpts
+ defaultDiagnosticOpts = defaultTcRnMessageOpts
diagnosticMessage opts = \case
TcRnUnknownMessage (UnknownDiagnostic @e m)
-> diagnosticMessage (defaultDiagnosticOpts @e) m
TcRnMessageWithInfo unit_state msg_with_info
-> case msg_with_info of
TcRnMessageDetailed err_info msg
- -> messageWithInfoDiagnosticMessage unit_state err_info (diagnosticMessage opts msg)
+ -> messageWithInfoDiagnosticMessage unit_state err_info
+ (tcOptsShowContext opts)
+ (diagnosticMessage opts msg)
TcRnSolverReport msg _ _
-> mkSimpleDecorated $ pprSolverReportWithCtxt msg
TcRnRedundantConstraints redundants (info, show_info)
@@ -1807,10 +1817,11 @@ deriveInstanceErrReasonHints cls newtype_deriving = \case
messageWithInfoDiagnosticMessage :: UnitState
-> ErrInfo
+ -> Bool
-> DecoratedSDoc
-> DecoratedSDoc
-messageWithInfoDiagnosticMessage unit_state ErrInfo{..} important =
- let err_info' = map (pprWithUnitState unit_state) [errInfoContext, errInfoSupplementary]
+messageWithInfoDiagnosticMessage unit_state ErrInfo{..} show_ctxt important =
+ let err_info' = map (pprWithUnitState unit_state) ([errInfoContext | show_ctxt] ++ [errInfoSupplementary])
in (mapDecoratedSDoc (pprWithUnitState unit_state) important) `unionDecoratedSDoc`
mkDecorated err_info'
diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst
index ca8d75860f..ecb64bbdb2 100644
--- a/docs/users_guide/using.rst
+++ b/docs/users_guide/using.rst
@@ -1360,6 +1360,18 @@ messages and in GHCi:
error was detected. This also affects the associated caret symbol that
points at the region of code at fault.
+.. ghc-flag:: -fshow-error-context
+ :shortdesc: Whether to show textual information about error context
+ :type: dynamic
+ :reverse: -fno-show-error-context
+ :category: verbosity
+
+ :default: on
+
+ Controls whether GHC displays information about the context in which an
+ error occurred. This controls whether the part of the error message which
+ says "In the equation..", "In the pattern.." etc is displayed or not.
+
.. ghc-flag:: -ferror-spans
:shortdesc: Output full span in error messages
:type: dynamic
diff --git a/testsuite/tests/driver/T21722.hs b/testsuite/tests/driver/T21722.hs
new file mode 100644
index 0000000000..fe40aadc61
--- /dev/null
+++ b/testsuite/tests/driver/T21722.hs
@@ -0,0 +1,6 @@
+module T21722 where
+
+main = print ()
+ where
+ foo :: Int
+ foo = "abc"
diff --git a/testsuite/tests/driver/T21722.stderr b/testsuite/tests/driver/T21722.stderr
new file mode 100644
index 0000000000..e66bbb3bea
--- /dev/null
+++ b/testsuite/tests/driver/T21722.stderr
@@ -0,0 +1,5 @@
+
+T21722.hs:6:11: error: [GHC-83865]
+ Couldn't match type β€˜[Char]’ with β€˜Int’
+ Expected: Int
+ Actual: String
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index 6a0932e9b0..3d1b417c91 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -313,3 +313,4 @@ test('T21349', extra_files(['T21349']), makefile_test, [])
test('T21869', [normal, when(unregisterised(), skip)], makefile_test, [])
test('T22044', normal, makefile_test, [])
test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"])
+test('T21722', normal, compile_fail, ['-fno-show-error-context'])
View Lorry Controller Status