Fix #22728: Not all diagnostics in safe check are fatal

Also add tests for the issue and -Winferred-safe-imports in general

1 files changed, 15 insertions, 13 deletions

diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 976cf12b55..255ffaf035 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -1468,19 +1468,21 @@ checkSafeImports tcg_env
         -- restore old errors
         logDiagnostics oldErrs
 
-        case (isEmptyMessages safeErrs) of
-          -- Failed safe check
-          False -> liftIO . throwErrors $ safeErrs
-
-          -- Passed safe check
-          True -> do
-            let infPassed = isEmptyMessages infErrs
-            tcg_env' <- case (not infPassed) of
-              True  -> markUnsafeInfer tcg_env infErrs
-              False -> return tcg_env
-            when (packageTrustOn dflags) $ checkPkgTrust pkgReqs
-            let newTrust = pkgTrustReqs dflags safePkgs infPkgs infPassed
-            return tcg_env' { tcg_imports = impInfo `plusImportAvails` newTrust }
+        diag_opts <- initDiagOpts <$> getDynFlags
+        print_config <- initPrintConfig <$> getDynFlags
+        logger <- getLogger
+
+        -- Will throw if failed safe check
+        liftIO $ printOrThrowDiagnostics logger print_config diag_opts safeErrs
+
+        -- No fatal warnings or errors: passed safe check
+        let infPassed = isEmptyMessages infErrs
+        tcg_env' <- case (not infPassed) of
+          True  -> markUnsafeInfer tcg_env infErrs
+          False -> return tcg_env
+        when (packageTrustOn dflags) $ checkPkgTrust pkgReqs
+        let newTrust = pkgTrustReqs dflags safePkgs infPkgs infPassed
+        return tcg_env' { tcg_imports = impInfo `plusImportAvails` newTrust }
 
   where
     impInfo  = tcg_imports tcg_env     -- ImportAvails