[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: testsuite: mark jspace as fragile on i386.

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Sun Dec 24 12:40:53 UTC 2023



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
0038d052 by Zubin Duggal at 2023-12-22T23:28:00-05:00
testsuite: mark jspace as fragile on i386.

This test has been flaky for some time and has been failing consistently on
i386-linux since 8e0446df landed.

See #24261

- - - - -
61c84065 by Ben Bellick at 2023-12-24T07:40:12-05:00
Deprecate -ddump-json and introduce -fdiagnostics-as-json

Addresses #19278

This commit deprecates the underspecified -ddump-json flag and
introduces a newer, well-specified flag -fdiagnostics-as-json.

Also included is a JSON schema as part of the documentation.

The -ddump-json flag will be slated for removal shortly after this merge.

- - - - -
2efbaf10 by Ben Bellick at 2023-12-24T07:40:12-05:00
Deprecate -ddump-json and introduce -fdiagnostics-as-json

Addresses #19278

This commit deprecates the underspecified -ddump-json flag and
introduces a newer, well-specified flag -fdiagnostics-as-json.

Also included is a JSON schema as part of the documentation.

The -ddump-json flag will be slated for removal shortly after this merge.

- - - - -
4b545594 by Ömer Sinan Ağacan at 2023-12-24T07:40:20-05:00
Fix BNF in user manual 6.6.8.2: formal syntax for instance declarations

- - - - -


23 changed files:

- compiler/GHC/Driver/Config/Logger.hs
- compiler/GHC/Driver/Errors.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Monad.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Types/SrcLoc.hs
- compiler/GHC/Utils/Logger.hs
- docs/users_guide/debugging.rst
- + docs/users_guide/diagnostics-as-json-schema-1_0.json
- docs/users_guide/exts/instances.rst
- docs/users_guide/using.rst
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/driver/T16167.stdout
- testsuite/tests/driver/all.T
- testsuite/tests/driver/j-space/all.T
- testsuite/tests/driver/json.hs
- testsuite/tests/driver/json.stderr
- testsuite/tests/driver/json2.stderr
- + testsuite/tests/driver/json_dump.hs
- + testsuite/tests/driver/json_dump.stderr
- + testsuite/tests/driver/json_warn.hs
- + testsuite/tests/driver/json_warn.stderr


Changes:

=====================================
compiler/GHC/Driver/Config/Logger.hs
=====================================
@@ -17,6 +17,7 @@ initLogFlags dflags = LogFlags
   , log_default_dump_context = initSDocContext dflags defaultDumpStyle
   , log_dump_flags           = dumpFlags dflags
   , log_show_caret           = gopt Opt_DiagnosticsShowCaret dflags
+  , log_diagnostics_as_json  = gopt Opt_DiagnosticsAsJSON dflags
   , log_show_warn_groups     = gopt Opt_ShowWarnGroups dflags
   , log_enable_timestamps    = not (gopt Opt_SuppressTimestamps dflags)
   , log_dump_to_file         = gopt Opt_DumpToFile dflags


=====================================
compiler/GHC/Driver/Errors.hs
=====================================
@@ -17,13 +17,15 @@ printMessages :: forall a . Diagnostic a => Logger -> DiagnosticOpts a -> DiagOp
 printMessages logger msg_opts opts msgs
   = sequence_ [ let style = mkErrStyle name_ppr_ctx
                     ctx   = (diag_ppr_ctx opts) { sdocStyle = style }
-                in logMsg logger (MCDiagnostic sev reason (diagnosticCode dia)) s $
-                   updSDocContext (\_ -> ctx) (messageWithHints dia)
-              | MsgEnvelope { errMsgSpan       = s,
-                              errMsgDiagnostic = dia,
-                              errMsgSeverity   = sev,
-                              errMsgReason     = reason,
-                              errMsgContext    = name_ppr_ctx }
+                in (if log_diags_as_json
+                    then logJsonMsg logger (MCDiagnostic sev reason (diagnosticCode dia)) msg
+                    else logMsg logger (MCDiagnostic sev reason (diagnosticCode dia)) s $
+                  updSDocContext (\_ -> ctx) (messageWithHints dia))
+              | msg at MsgEnvelope { errMsgSpan       = s,
+                                  errMsgDiagnostic = dia,
+                                  errMsgSeverity   = sev,
+                                  errMsgReason     = reason,
+                                  errMsgContext    = name_ppr_ctx }
                   <- sortMsgBag (Just opts) (getMessages msgs) ]
   where
     messageWithHints :: Diagnostic a => a -> SDoc
@@ -34,6 +36,7 @@ printMessages logger msg_opts opts msgs
                [h] -> main_msg $$ hang (text "Suggested fix:") 2 (ppr h)
                hs  -> main_msg $$ hang (text "Suggested fixes:") 2
                                        (formatBulleted  $ mkDecorated . map ppr $ hs)
+    log_diags_as_json = log_diagnostics_as_json (logFlags logger)
 
 -- | Given a bag of diagnostics, turn them into an exception if
 -- any has 'SevError', or print them out otherwise.


=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -412,6 +412,7 @@ data GeneralFlag
    | Opt_ErrorSpans -- Include full span info in error messages,
                     -- instead of just the start position.
    | Opt_DeferDiagnostics
+   | Opt_DiagnosticsAsJSON  -- ^ Dump diagnostics as JSON
    | Opt_DiagnosticsShowCaret -- Show snippets of offending code
    | Opt_PprCaseAsLet
    | Opt_PprShowTicks


=====================================
compiler/GHC/Driver/Monad.hs
=====================================
@@ -23,6 +23,8 @@ module GHC.Driver.Monad (
         modifyLogger,
         pushLogHookM,
         popLogHookM,
+        pushJsonLogHookM,
+        popJsonLogHookM,
         putLogMsgM,
         putMsgM,
         withTimingM,
@@ -121,6 +123,12 @@ pushLogHookM = modifyLogger . pushLogHook
 popLogHookM :: GhcMonad m => m ()
 popLogHookM  = modifyLogger popLogHook
 
+pushJsonLogHookM :: GhcMonad m => (LogJsonAction -> LogJsonAction) -> m ()
+pushJsonLogHookM = modifyLogger . pushJsonLogHook
+
+popJsonLogHookM :: GhcMonad m => m ()
+popJsonLogHookM = modifyLogger popJsonLogHook
+
 -- | Put a log message
 putMsgM :: GhcMonad m => SDoc -> m ()
 putMsgM doc = do


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -1573,15 +1573,15 @@ dynamic_flags_deps = [
         (NoArg (setGeneralFlag Opt_NoTypeableBinds))
   , make_ord_flag defGhcFlag "ddump-debug"
         (setDumpFlag Opt_D_dump_debug)
-  , make_ord_flag defGhcFlag "ddump-json"
-        (setDumpFlag Opt_D_dump_json )
+  , make_dep_flag defGhcFlag "ddump-json"
+        (setDumpFlag Opt_D_dump_json)
+        "Use `-fdiagnostics-as-json` instead"
   , make_ord_flag defGhcFlag "dppr-debug"
         (setDumpFlag Opt_D_ppr_debug)
   , make_ord_flag defGhcFlag "ddebug-output"
         (noArg (flip dopt_unset Opt_D_no_debug_output))
   , make_ord_flag defGhcFlag "dno-debug-output"
         (setDumpFlag Opt_D_no_debug_output)
-
   , make_ord_flag defGhcFlag "ddump-faststrings"
         (setDumpFlag Opt_D_dump_faststrings)
 
@@ -2354,6 +2354,7 @@ fFlagsDeps = [
   flagSpec "defer-typed-holes"                Opt_DeferTypedHoles,
   flagSpec "defer-out-of-scope-variables"     Opt_DeferOutOfScopeVariables,
   flagSpec "diagnostics-show-caret"           Opt_DiagnosticsShowCaret,
+  flagSpec "diagnostics-as-json"              Opt_DiagnosticsAsJSON,
   -- With-ways needs to be reversible hence why its made via flagSpec unlike
   -- other debugging flags.
   flagSpec "dump-with-ways"                   Opt_DumpWithWays,


=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -103,15 +103,16 @@ import GHC.Data.StringBuffer (atLine, hGetStringBuffer, len, lexemeToString)
 import GHC.Utils.Json
 import GHC.Utils.Panic
 import GHC.Unit.Module.Warnings (WarningCategory)
-
 import Data.Bifunctor
-import Data.Foldable    ( fold )
+import Data.Foldable    ( fold, toList )
 import Data.List.NonEmpty ( NonEmpty (..) )
 import qualified Data.List.NonEmpty as NE
 import Data.List ( intercalate )
 import Data.Typeable ( Typeable )
 import Numeric.Natural ( Natural )
 import Text.Printf ( printf )
+import GHC.Version (cProjectVersion)
+import GHC.Types.Hint.Ppr () -- Outputtable instance
 
 {- Note [Messages]
 ~~~~~~~~~~~~~~~~~~
@@ -166,6 +167,9 @@ instance Diagnostic e => Outputable (Messages e) where
                pprDiagnostic (errMsgDiagnostic envelope)
              ]
 
+instance Diagnostic e => ToJson (Messages e) where
+  json msgs =  JSArray . toList $ json <$> getMessages msgs
+
 {- Note [Discarding Messages]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -540,7 +544,9 @@ instance Outputable Severity where
     SevError   -> text "SevError"
 
 instance ToJson Severity where
-  json s = JSString (show s)
+  json SevIgnore = JSString "Ignore"
+  json SevWarning = JSString "Warning"
+  json SevError = JSString "Error"
 
 instance ToJson MessageClass where
   json MCOutput = JSString "MCOutput"
@@ -551,6 +557,45 @@ instance ToJson MessageClass where
   json (MCDiagnostic sev reason code) =
     JSString $ renderWithContext defaultSDocContext (ppr $ text "MCDiagnostic" <+> ppr sev <+> ppr reason <+> ppr code)
 
+instance ToJson DiagnosticCode where
+  json c = JSInt (fromIntegral (diagnosticCodeNumber c))
+
+{- Note [Diagnostic Message JSON Schema]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The below instance of ToJson must conform to the JSON schema
+specified in docs/users_guide/diagnostics-as-json-schema-1_0.json.
+When the schema is altered, please bump the version.
+If the content is altered in a backwards compatible way,
+update the minor version (e.g. 1.3 ~> 1.4).
+If the content is breaking, update the major version (e.g. 1.3 ~> 2.3).
+When updating the schema, replace the above file and name it appropriately with
+the version appended, and change the documentation of the -fdiagnostics-as-json
+flag to reflect the new schema.
+To learn more about JSON schemas, check out the below link:
+https://json-schema.org
+-}
+
+schemaVersion :: String
+schemaVersion = "1.0"
+-- See Note [Diagnostic Message JSON Schema] before editing!
+instance Diagnostic e => ToJson (MsgEnvelope e) where
+  json m = JSObject [
+    ("version", JSString schemaVersion),
+    ("ghcVersion", JSString $ "ghc-" ++ cProjectVersion),
+    ("span", json $ errMsgSpan m),
+    ("severity", json $ errMsgSeverity m),
+    ("code", maybe JSNull json (diagnosticCode diag)),
+    ("message", JSArray $ map renderToJSString diagMsg),
+    ("hints", JSArray $ map (renderToJSString . ppr) (diagnosticHints diag) )
+    ]
+    where diag = errMsgDiagnostic m
+          opts = defaultDiagnosticOpts @e
+          style = mkErrStyle (errMsgContext m)
+          ctx = defaultSDocContext {sdocStyle = style }
+          diagMsg = filter (not . isEmpty ctx) (unDecorated (diagnosticMessage (opts) diag))
+          renderToJSString :: SDoc -> JsonDoc
+          renderToJSString = JSString . (renderWithContext ctx)
+
 instance Show (MsgEnvelope DiagnosticMessage) where
     show = showMsgEnvelope
 


=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -426,12 +426,14 @@ instance ToJson SrcSpan where
   json (RealSrcSpan rss _) = json rss
 
 instance ToJson RealSrcSpan where
-  json (RealSrcSpan'{..}) = JSObject [ ("file", JSString (unpackFS srcSpanFile))
-                                     , ("startLine", JSInt srcSpanSLine)
-                                     , ("startCol", JSInt srcSpanSCol)
-                                     , ("endLine", JSInt srcSpanELine)
-                                     , ("endCol", JSInt srcSpanECol)
+  json (RealSrcSpan'{..}) = JSObject [ ("file", JSString (unpackFS srcSpanFile)),
+                                       ("start", start),
+                                       ("end", end)
                                      ]
+    where start = JSObject [ ("line", JSInt srcSpanSLine),
+                             ("column", JSInt srcSpanSCol) ]
+          end = JSObject [ ("line", JSInt srcSpanELine),
+                           ("column", JSInt srcSpanECol) ]
 
 instance NFData SrcSpan where
   rnf x = x `seq` ()


=====================================
compiler/GHC/Utils/Logger.hs
=====================================
@@ -24,6 +24,7 @@ module GHC.Utils.Logger
     -- * Logger setup
     , initLogger
     , LogAction
+    , LogJsonAction
     , DumpAction
     , TraceAction
     , DumpFormat (..)
@@ -31,6 +32,8 @@ module GHC.Utils.Logger
     -- ** Hooks
     , popLogHook
     , pushLogHook
+    , popJsonLogHook
+    , pushJsonLogHook
     , popDumpHook
     , pushDumpHook
     , popTraceHook
@@ -49,12 +52,13 @@ module GHC.Utils.Logger
     , logVerbAtLeast
 
     -- * Logging
-    , jsonLogAction
     , putLogMsg
     , defaultLogAction
+    , defaultLogJsonAction
     , defaultLogActionHPrintDoc
     , defaultLogActionHPutStrDoc
     , logMsg
+    , logJsonMsg
     , logDumpMsg
 
     -- * Dumping
@@ -87,6 +91,7 @@ import GHC.Utils.Panic
 
 import GHC.Data.EnumSet (EnumSet)
 import qualified GHC.Data.EnumSet as EnumSet
+import GHC.Data.FastString
 
 import System.Directory
 import System.FilePath  ( takeDirectory, (</>) )
@@ -111,6 +116,7 @@ data LogFlags = LogFlags
   , log_default_dump_context :: SDocContext
   , log_dump_flags           :: !(EnumSet DumpFlag) -- ^ Dump flags
   , log_show_caret           :: !Bool               -- ^ Show caret in diagnostics
+  , log_diagnostics_as_json  :: !Bool               -- ^ Format diagnostics as JSON
   , log_show_warn_groups     :: !Bool               -- ^ Show warning flag groups
   , log_enable_timestamps    :: !Bool               -- ^ Enable timestamps
   , log_dump_to_file         :: !Bool               -- ^ Enable dump to file
@@ -130,6 +136,7 @@ defaultLogFlags = LogFlags
   , log_default_dump_context = defaultSDocContext
   , log_dump_flags           = EnumSet.empty
   , log_show_caret           = True
+  , log_diagnostics_as_json  = False
   , log_show_warn_groups     = True
   , log_enable_timestamps    = True
   , log_dump_to_file         = False
@@ -177,6 +184,11 @@ type LogAction = LogFlags
               -> SDoc
               -> IO ()
 
+type LogJsonAction = LogFlags
+                   -> MessageClass
+                   -> JsonDoc
+                   -> IO ()
+
 type DumpAction = LogFlags
                -> PprStyle
                -> DumpFlag
@@ -214,6 +226,9 @@ data Logger = Logger
     { log_hook   :: [LogAction -> LogAction]
         -- ^ Log hooks stack
 
+    , json_log_hook :: [LogJsonAction -> LogJsonAction]
+        -- ^ Json log hooks stack
+
     , dump_hook  :: [DumpAction -> DumpAction]
         -- ^ Dump hooks stack
 
@@ -249,6 +264,7 @@ initLogger = do
     dumps <- newMVar Map.empty
     return $ Logger
         { log_hook        = []
+        , json_log_hook   = []
         , dump_hook       = []
         , trace_hook      = []
         , generated_dumps = dumps
@@ -260,6 +276,10 @@ initLogger = do
 putLogMsg :: Logger -> LogAction
 putLogMsg logger = foldr ($) defaultLogAction (log_hook logger)
 
+-- | Log a JsonDoc
+putJsonLogMsg :: Logger -> LogJsonAction
+putJsonLogMsg logger = foldr ($) defaultLogJsonAction (json_log_hook logger)
+
 -- | Dump something
 putDumpFile :: Logger -> DumpAction
 putDumpFile logger =
@@ -284,6 +304,15 @@ popLogHook logger = case log_hook logger of
     []   -> panic "popLogHook: empty hook stack"
     _:hs -> logger { log_hook = hs }
 
+-- | Push a json log hook
+pushJsonLogHook :: (LogJsonAction -> LogJsonAction) -> Logger -> Logger
+pushJsonLogHook h logger = logger { json_log_hook = h:json_log_hook logger }
+
+popJsonLogHook :: Logger -> Logger
+popJsonLogHook logger = case json_log_hook logger of
+    []   -> panic "popJsonLogHook: empty hook stack"
+    _:hs -> logger { json_log_hook = hs}
+
 -- | Push a dump hook
 pushDumpHook :: (DumpAction -> DumpAction) -> Logger -> Logger
 pushDumpHook h logger = logger { dump_hook = h:dump_hook logger }
@@ -328,7 +357,23 @@ makeThreadSafe logger = do
            $ logger
 
 -- See Note [JSON Error Messages]
---
+defaultLogJsonAction :: LogJsonAction
+defaultLogJsonAction logflags msg_class jsdoc =
+  case msg_class of
+      MCOutput                     -> printOut msg
+      MCDump                       -> printOut (msg $$ blankLine)
+      MCInteractive                -> putStrSDoc msg
+      MCInfo                       -> printErrs msg
+      MCFatal                      -> printErrs msg
+      MCDiagnostic SevIgnore _ _   -> pure () -- suppress the message
+      MCDiagnostic _sev _rea _code -> printErrs msg
+  where
+    printOut   = defaultLogActionHPrintDoc  logflags False stdout
+    printErrs  = defaultLogActionHPrintDoc  logflags False stderr
+    putStrSDoc = defaultLogActionHPutStrDoc logflags False stdout
+    msg = renderJSON jsdoc
+-- See Note [JSON Error Messages]
+-- this is to be removed
 jsonLogAction :: LogAction
 jsonLogAction _ (MCDiagnostic SevIgnore _ _) _ _ = return () -- suppress the message
 jsonLogAction logflags msg_class srcSpan msg
@@ -338,10 +383,20 @@ jsonLogAction logflags msg_class srcSpan msg
     where
       str = renderWithContext (log_default_user_context logflags) msg
       doc = renderJSON $
-              JSObject [ ( "span", json srcSpan )
+              JSObject [ ( "span", spanToDumpJSON srcSpan )
                        , ( "doc" , JSString str )
                        , ( "messageClass", json msg_class )
                        ]
+      spanToDumpJSON :: SrcSpan -> JsonDoc
+      spanToDumpJSON s = case s of
+                 (RealSrcSpan rss _) -> JSObject [ ("file", json file)
+                                                , ("startLine", json $ srcSpanStartLine rss)
+                                                , ("startCol", json $ srcSpanStartCol rss)
+                                                , ("endLine", json $ srcSpanEndLine rss)
+                                                , ("endCol", json $ srcSpanEndCol rss)
+                                                ]
+                   where file = unpackFS $ srcSpanFile rss
+                 UnhelpfulSpan _ -> JSNull
 
 defaultLogAction :: LogAction
 defaultLogAction logflags msg_class srcSpan msg
@@ -403,6 +458,12 @@ defaultLogActionHPutStrDoc logflags asciiSpace h d
 -- information to provide to the user but refactoring log_action is quite
 -- invasive as it is called in many places. So, for now I left it alone
 -- and we can refine its behaviour as users request different output.
+--
+-- The recent work here replaces the purpose of flag -ddump-json with
+-- -fdiagnostics-as-json. For temporary backwards compatibility while
+-- -ddump-json is being deprecated, `jsonLogAction` has been added in, but
+-- it should be removed along with -ddump-json. Similarly, the guard in
+-- `defaultLogAction` should be removed. This cleanup is tracked in #24113.
 
 -- | Default action for 'dumpAction' hook
 defaultDumpAction :: DumpCache -> LogAction -> DumpAction
@@ -532,6 +593,9 @@ defaultTraceAction logflags title doc x =
 logMsg :: Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
 logMsg logger mc loc msg = putLogMsg logger (logFlags logger) mc loc msg
 
+logJsonMsg :: ToJson a => Logger -> MessageClass -> a -> IO ()
+logJsonMsg logger mc d = putJsonLogMsg logger (logFlags logger) mc  (json d)
+
 -- | Dump something
 logDumpFile :: Logger -> PprStyle -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
 logDumpFile logger = putDumpFile logger (logFlags logger)


=====================================
docs/users_guide/debugging.rst
=====================================
@@ -56,12 +56,11 @@ Dumping out compiler intermediate structures
     output of one way with the output of another.
 
 .. ghc-flag:: -ddump-json
-    :shortdesc: Dump error messages as JSON documents
+    :shortdesc: *(deprecated)* Use :ghc-flag:`-fdiagnostics-as-json` instead
     :type: dynamic
 
-    Dump error messages as JSON documents. This is intended to be consumed
-    by external tooling. A good way to use it is in conjunction with
-    :ghc-flag:`-ddump-to-file`.
+    This flag was previously used to generated JSON formatted GHC diagnostics,
+    but has been deprecated. Instead, use :ghc-flag:`-fdiagnostics-as-json`.
 
 .. ghc-flag:: -dshow-passes
     :shortdesc: Print out each pass name as it happens


=====================================
docs/users_guide/diagnostics-as-json-schema-1_0.json
=====================================
@@ -0,0 +1,103 @@
+{
+  "$schema": "https://json-schema.org/draft/2020-12/schema",
+  "title": "JSON Diagnostic Schema",
+  "description": "A Schema for specifying GHC diagnostics output as JSON",
+  "type": "object",
+  "properties": {
+    "version": {
+      "description": "The current JSON schema version this object conforms to",
+      "type": "string"
+    },
+    "ghcVersion": {
+      "description": "The GHC version",
+      "type": "string"
+    },
+    "span": {
+      "$ref": "#/$defs/span"
+    },
+    "severity": {
+      "description": "The diagnostic severity",
+      "type": "string",
+      "enum": [
+        "Warning",
+        "Error"
+      ]
+    },
+    "code": {
+      "description": "The diagnostic code (if it exists)",
+      "type": [
+        "integer",
+        "null"
+      ]
+    },
+    "message": {
+      "description": "The string output of the diagnostic message by GHC",
+      "type": "array",
+      "items": {
+        "type": "string"
+      }
+    },
+    "hints": {
+      "description": "The suggested fixes",
+      "type": "array",
+      "items": {
+        "type": "string"
+      }
+    }
+  },
+  "required": [
+    "version",
+    "ghcVersion",
+    "span",
+    "severity",
+    "code",
+    "message",
+    "hints"
+  ],
+  "additionalProperties": false,
+  "$defs": {
+    "span": {
+      "description": "The span of the diagnostic",
+      "type": "object",
+      "properties": {
+        "file": {
+          "description": "The file in which the diagnostic occurs",
+          "type": "string"
+        },
+        "start": {
+          "description": "The start location of the diagnostic",
+          "$ref": "#/$defs/location"
+        },
+        "end": {
+          "description": "The end location of the diagnostic",
+          "$ref": "#/$defs/location"
+        }
+      },
+      "required": [
+        "file",
+        "start",
+        "end"
+      ],
+      "additionalProperties": false
+    },
+    "location": {
+      "description": "A location in a text file",
+      "type": "object",
+      "properties": {
+        "line": {
+          "description": "The line number",
+          "type": "integer"
+        },
+        "column": {
+          "description": "The column number",
+          "type": "integer"
+        }
+      },
+      "required": [
+        "line",
+        "column"
+      ],
+      "additionalProperties": false
+    }
+  }
+}


=====================================
docs/users_guide/exts/instances.rst
=====================================
@@ -139,8 +139,8 @@ BNF-style grammar for the tops of instance declarations below.
              |  arg_type infix_cls_tycon arg_type
              |  '(' arg_type infix_cls_tycon arg_type ')' arg_types
 
-  arg_type ::= <empty>
-            |  arg_type arg_types
+  arg_types ::= <empty>
+             |  arg_type arg_types
 
   opt_where ::= <empty>
              |  'where'


=====================================
docs/users_guide/using.rst
=====================================
@@ -1403,6 +1403,19 @@ messages and in GHCi:
     find the relevant errors or likely to ignore the warnings when they are
     mixed with many other messages.
 
+.. ghc-flag:: -fdiagnostics-as-json
+    :shortdesc: Output diagnostics in Json format specified by JSON schema
+    :type: dynamic
+    :category: verbosity
+
+    Causes GHC to emit diagnostic messages in a standardized JSON format,
+    and output them directly to ``stderr``. The format follows the `JSON Lines <https://jsonlines.org>`_
+    convention, where each diagnostic is its own JSON object separated by
+    a new line.
+
+    The structure of the output is described by a `JSON Schema <https://json-schema.org/>`_.
+    The schema can be downloaded :download:`here <diagnostics-as-json-schema-1_0.json>`.
+    
 .. ghc-flag:: -fdiagnostics-color=⟨always|auto|never⟩
     :shortdesc: Use colors in error messages
     :type: dynamic


=====================================
testsuite/tests/count-deps/CountDepsAst.stdout
=====================================
@@ -151,6 +151,7 @@ GHC.Types.ForeignCall
 GHC.Types.ForeignStubs
 GHC.Types.GREInfo
 GHC.Types.Hint
+GHC.Types.Hint.Ppr
 GHC.Types.HpcInfo
 GHC.Types.Id
 GHC.Types.Id.Info


=====================================
testsuite/tests/driver/T16167.stdout
=====================================
@@ -1 +1,2 @@
+{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"}
 {"span":{"file":"T16167.hs","startLine":1,"startCol":8,"endLine":1,"endCol":9},"doc":"parse error on input \u2018f\u2019","messageClass":"MCDiagnostic SevError ErrorWithoutFlag Just GHC-58481"}


=====================================
testsuite/tests/driver/all.T
=====================================
@@ -273,13 +273,11 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef'])
 test('T12955', normal, makefile_test, [])
 
 test('T12971', [when(opsys('mingw32'), fragile(17945)), ignore_stdout], makefile_test, [])
-test('json', normal, compile_fail, ['-ddump-json'])
-
-# json2 test is sensitive to the LLVM not supported ouput from GHC. ANd the error
-# won't tell.  It looks unrelated and is annoying to debug. Hence we disable the
-# warning to prevent spurious errors.
+test('json_dump', normal, compile_fail, ['-ddump-json'])
+test('json', normalise_version('ghc'), compile_fail, ['-fdiagnostics-as-json'])
+test('json_warn', normalise_version('ghc'), compile, ['-fdiagnostics-as-json -Wunused-matches'])
 test('json2', normalise_version('base','ghc-prim'), compile, ['-ddump-types -ddump-json -Wno-unsupported-llvm-version'])
-test('T16167', [req_interp,exit_code(1)], run_command,
+test('T16167', [normalise_version('ghc'),req_interp,exit_code(1)], run_command,
      ['{compiler} -x hs -e ":set prog T16167.hs" -ddump-json T16167.hs'])
 test('T13604', [], makefile_test, [])
 test('T13604a',


=====================================
testsuite/tests/driver/j-space/all.T
=====================================
@@ -1 +1 @@
-test('jspace', [extra_files(['genJspace']), req_target_smp, req_ghc_smp, js_broken(22573)], makefile_test, ['jspace'])
+test('jspace', [extra_files(['genJspace']), req_target_smp, req_ghc_smp, js_broken(22573),when(arch('i386'), fragile(24261))], makefile_test, ['jspace'])


=====================================
testsuite/tests/driver/json.hs
=====================================
@@ -1,6 +1,9 @@
+{-# LANGUAGE NoEmptyCase #-}
 module Foo where
 
 import Data.List
 
-id1 :: a -> a
-id1 = 5
+f1 :: a -> a
+f1 x = 5
+
+f2 x = do case () of


=====================================
testsuite/tests/driver/json.stderr
=====================================
@@ -1 +1 @@
-{"span":{"file":"json.hs","startLine":6,"startCol":7,"endLine":6,"endCol":8},"doc":"\u2022 No instance for \u2018Num (a -> a)\u2019 arising from the literal \u20185\u2019\n    (maybe you haven't applied a function to enough arguments?)\n\u2022 In the expression: 5\n  In an equation for \u2018id1\u2019: id1 = 5","messageClass":"MCDiagnostic SevError ErrorWithoutFlag Just GHC-39999"}
+{"version":"1.0","ghcVersion":"ghc-9.9.20230817","span":{"file":"json.hs","start":{"line":9,"column":11},"end":{"line":9,"column":21}},"severity":"Error","code":48010,"message":["Empty list of alternatives in case expression"],"hints":["Perhaps you intended to use EmptyCase"]}


=====================================
testsuite/tests/driver/json2.stderr
=====================================
@@ -1 +1,2 @@
-{"span":null,"doc":"TYPE SIGNATURES\n  foo :: forall a. a -> a\nDependent modules: []\nDependent packages: [base-4.16.0.0]","messageClass":"MCOutput"}
+{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"}
+{"span":null,"doc":"TYPE SIGNATURES\n  foo :: forall a. a -> a\nDependent modules: []\nDependent packages: [base-4.19.0.0]","messageClass":"MCOutput"}


=====================================
testsuite/tests/driver/json_dump.hs
=====================================
@@ -0,0 +1,6 @@
+module Foo where
+
+import Data.List
+
+id1 :: a -> a
+id1 = 5


=====================================
testsuite/tests/driver/json_dump.stderr
=====================================
@@ -0,0 +1,2 @@
+{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"}
+{"span":{"file":"json_dump.hs","startLine":6,"startCol":7,"endLine":6,"endCol":8},"doc":"\u2022 No instance for \u2018Num (a -> a)\u2019 arising from the literal \u20185\u2019\n    (maybe you haven't applied a function to enough arguments?)\n\u2022 In the expression: 5\n  In an equation for \u2018id1\u2019: id1 = 5","messageClass":"MCDiagnostic SevError ErrorWithoutFlag Just GHC-39999"}


=====================================
testsuite/tests/driver/json_warn.hs
=====================================
@@ -0,0 +1,4 @@
+module Foo where
+
+f :: Int -> Int
+f x = 5


=====================================
testsuite/tests/driver/json_warn.stderr
=====================================
@@ -0,0 +1 @@
+{"version":"1.0","ghcVersion":"ghc-9.9.20230817","span":{"file":"json_warn.hs","start":{"line":4,"column":3},"end":{"line":4,"column":4}},"severity":"Warning","code":40910,"message":["Defined but not used: `x'"],"hints":[]}



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b71536b44da94dc08336379627c32dd509423ce...4b54559436f0e18760b9d47c6d959b24208897f2

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b71536b44da94dc08336379627c32dd509423ce...4b54559436f0e18760b9d47c6d959b24208897f2
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231224/554f163a/attachment-0001.html>


More information about the ghc-commits mailing list