GitLab

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

bf03bbaa

by Simon Hengel at 2025-08-01T04:39:05-04:00

Don't use MCDiagnostic for `ghcExit`

This changes the error message of `ghcExit` from

```
<no location info>: error:
Compilation had errors

```
to
```

Compilation had errors

```

a889ec75

by Simon Hengel at 2025-08-01T04:39:05-04:00

Respect `-fdiagnostics-as-json` for driver diagnostics (see #24113)

5 changed files:

compiler/GHC/Driver/Make.hs
compiler/GHC/Linker/Loader.hs
compiler/GHC/SysTools/Tasks.hs
compiler/GHC/Utils/Error.hs
testsuite/tests/corelint/T21115b.stderr

Changes:

compiler/GHC/Driver/Make.hs

@@ -1552,7 +1552,7 @@ wrapAction msg_wrapper hsc_env k = do
                          -- ThreadKilled in particular needs to actually kill the thread.
                          -- So rethrow that and the other async exceptions
                          Just (err :: SomeAsyncException) -> throwIO err
 -                        _ -> errorMsg lcl_logger (text (show exc))
 +                        _ -> reportError lcl_logger neverQualify emptyDiagOpts noSrcSpan (text (show exc))
          return Nothing

compiler/GHC/Linker/Loader.hs

@@ -43,6 +43,7 @@ import GHC.Settings
  import GHC.Platform
  import GHC.Platform.Ways
 +import GHC.Driver.Errors
  import GHC.Driver.Phases
  import GHC.Driver.Env
  import GHC.Driver.Session
@@ -50,7 +51,7 @@ import GHC.Driver.Ppr
  import GHC.Driver.Config.Diagnostic
  import GHC.Driver.Config.Finder
 -import GHC.Tc.Utils.Monad
 +import GHC.Tc.Utils.Monad hiding (reportDiagnostic)
  import GHC.Runtime.Interpreter
  import GHCi.BreakArray
@@ -1309,9 +1310,9 @@ load_dyn interp hsc_env crash_early dll = do
          then cmdLineErrorIO err
          else do
            when (diag_wopt Opt_WarnMissedExtraSharedLib diag_opts)
 -            $ logMsg logger
 -                (mkMCDiagnostic diag_opts (WarningWithFlag Opt_WarnMissedExtraSharedLib) Nothing)
 -                  noSrcSpan $ withPprStyle defaultUserStyle (note err)
 +            $ reportDiagnostic logger
 +                neverQualify diag_opts
 +                  noSrcSpan (WarningWithFlag Opt_WarnMissedExtraSharedLib) $ withPprStyle defaultUserStyle (note err)
            pure Nothing
    where
      diag_opts = initDiagOpts (hsc_dflags hsc_env)
@@ -1499,8 +1500,7 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
        , not loading_dynamic_hs_libs
        , interpreterProfiled interp
        = do
 -          let diag = mkMCDiagnostic diag_opts WarningWithoutFlag Nothing
 -          logMsg logger diag noSrcSpan $ withPprStyle defaultErrStyle $
 +          reportDiagnostic logger neverQualify diag_opts noSrcSpan WarningWithoutFlag $ withPprStyle defaultErrStyle $
              text "Interpreter failed to load profiled static library" <+> text lib <> char '.' $$
                text " \tTrying dynamic library instead. If this fails try to rebuild" <+>
                text "libraries with profiling support."

compiler/GHC/SysTools/Tasks.hs

@@ -55,7 +55,7 @@ import GHC.Driver.Config.Diagnostic
  import GHC.Driver.Errors
  import GHC.Driver.Errors.Types (GhcMessage(..), DriverMessage (DriverNoConfiguredLLVMToolchain))
  import GHC.Driver.CmdLine (warnsToMessages)
 -import GHC.Types.SrcLoc (noLoc)
 +import GHC.Types.SrcLoc (noLoc, noSrcSpan)
  {-
  ************************************************************************
@@ -346,7 +346,7 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do
                  debugTraceMsg logger 2
                      (text "Error (figuring out LLVM version):" <+>
                        text (show err))
 -                errorMsg logger $ vcat
 +                reportError logger neverQualify emptyDiagOpts noSrcSpan $ vcat
                      [ text "Warning:", nest 9 $
                            text "Couldn't figure out LLVM version!" $$
                            text ("Make sure you have installed LLVM between ["

compiler/GHC/Utils/Error.hs

@@ -32,7 +32,7 @@ module GHC.Utils.Error (
          emptyMessages, mkDecorated, mkLocMessage,
          mkMsgEnvelope, mkPlainMsgEnvelope, mkPlainErrorMsgEnvelope,
          mkErrorMsgEnvelope,
 -        mkMCDiagnostic, errorDiagnostic, diagReasonSeverity,
 +        mkMCDiagnostic, diagReasonSeverity,
          mkPlainError,
          mkPlainDiagnostic,
@@ -46,7 +46,6 @@ module GHC.Utils.Error (
          -- * Issuing messages during compilation
          putMsg, printInfoForUser, printOutputForUser,
          logInfo, logOutput,
 -        errorMsg,
          fatalErrorMsg,
          compilationProgressMsg,
          showPass,
@@ -168,11 +167,6 @@ mkMCDiagnostic opts reason code = MCDiagnostic sev reason' code
    where
      (sev, reason') = diag_reason_severity opts reason
 --- | Varation of 'mkMCDiagnostic' which can be used when we are /sure/ the
 --- input 'DiagnosticReason' /is/ 'ErrorWithoutFlag' and there is no diagnostic code.
 -errorDiagnostic :: MessageClass
 -errorDiagnostic = MCDiagnostic SevError (ResolvedDiagnosticReason ErrorWithoutFlag) Nothing
+-
  --
  -- Creating MsgEnvelope(s)
  --
@@ -318,17 +312,12 @@ sortMsgBag mopts = maybeLimit . sortBy (cmp `on` errMsgSpan) . bagToList
  ghcExit :: Logger -> Int -> IO ()
  ghcExit logger val
    | val == 0  = exitWith ExitSuccess
 -  | otherwise = do errorMsg logger (text "\nCompilation had errors\n\n")
 +  | otherwise = do fatalErrorMsg logger (text "\nCompilation had errors\n\n")
                     exitWith (ExitFailure val)
  -- -----------------------------------------------------------------------------
  -- Outputting messages from the compiler
 -errorMsg :: Logger -> SDoc -> IO ()
 -errorMsg logger msg
 -   = logMsg logger errorDiagnostic noSrcSpan $
 -     withPprStyle defaultErrStyle msg
+-
  fatalErrorMsg :: Logger -> SDoc -> IO ()
  fatalErrorMsg logger msg =
      logMsg logger MCFatal noSrcSpan $ withPprStyle defaultErrStyle msg

testsuite/tests/corelint/T21115b.stderr

@@ -30,6 +30,6 @@ end Rec }
  *** End of Offense ***
+-
 -<no location info>: error:
  Compilation had errors
++
++