Simon Hengel pushed to branch wip/sol/driver-diagnostics at Glasgow Haskell Compiler / GHC Commits: 9a98ce6e by Simon Hengel at 2025-07-27T15:12:07+07: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 ``` - - - - - a800b480 by Simon Hengel at 2025-07-27T15:12:07+07: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 @@ -1307,9 +1308,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) @@ -1497,8 +1498,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 + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68bd5e0bba978135493bde60cffeb4d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68bd5e0bba978135493bde60cffeb4d... You're receiving this email because of your account on gitlab.haskell.org.