From daf7bcbf0f5dfaf019b295738a63d50972bb4ee4 Mon Sep 17 00:00:00 2001
From: Matthew Pickering <matthewtpickering@gmail.com>
Date: Tue, 1 Nov 2022 12:22:05 +0000
Subject: [PATCH] driver: Fix -fdefer-diagnostics flag

The `withDeferredDiagnostics` wrapper wasn't doing anything because the
session it was modifying wasn't used in hsc_env. Therefore the fix is
simple, just push the `getSession` call into the scope of
`withDeferredDiagnostics`.

Fixes #22391
---
 compiler/GHC/Driver/Make.hs                  |  4 +-
 testsuite/tests/driver/t22391/Makefile       | 19 +++++++++
 testsuite/tests/driver/t22391/all.T          |  5 +++
 testsuite/tests/driver/t22391/src/Lib.hs     | 11 +++++
 testsuite/tests/driver/t22391/src/Lib/A.hs   |  3 ++
 testsuite/tests/driver/t22391/src/Lib/B.hs   |  3 ++
 testsuite/tests/driver/t22391/t22391.stderr  | 43 ++++++++++++++++++++
 testsuite/tests/driver/t22391/t22391j.stderr | 43 ++++++++++++++++++++
 testsuite/tests/ghci/prog018/prog018.stdout  |  7 +---
 9 files changed, 131 insertions(+), 7 deletions(-)
 create mode 100644 testsuite/tests/driver/t22391/Makefile
 create mode 100644 testsuite/tests/driver/t22391/all.T
 create mode 100644 testsuite/tests/driver/t22391/src/Lib.hs
 create mode 100644 testsuite/tests/driver/t22391/src/Lib/A.hs
 create mode 100644 testsuite/tests/driver/t22391/src/Lib/B.hs
 create mode 100644 testsuite/tests/driver/t22391/t22391.stderr
 create mode 100644 testsuite/tests/driver/t22391/t22391j.stderr

diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index ff2b73eea39d..462a52ea45fc 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -741,8 +741,8 @@ load' mhmi_cache how_much mHscMessage mod_graph = do
                     Just n  -> return n
 
     setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env
-    hsc_env <- getSession
-    (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $
+    (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do
+      hsc_env <- getSession
       liftIO $ upsweep n_jobs hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan
     setSession hsc_env1
     case upsweep_ok of
diff --git a/testsuite/tests/driver/t22391/Makefile b/testsuite/tests/driver/t22391/Makefile
new file mode 100644
index 000000000000..7b9e287e3dd3
--- /dev/null
+++ b/testsuite/tests/driver/t22391/Makefile
@@ -0,0 +1,19 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+warnings-ghc-deferred: clean
+	"$GHC" --make -Wall -fdefer-diagnostics src/Lib.hs src/Lib/A.hs src/Lib/B.hs"
+	ghc --version
+
+warnings-ghc-regular: clean
+	bash -c "ghc --make -Wall src/Lib.hs src/Lib/A.hs src/Lib/B.hs"
+	ghc --version
+
+.PHONY: warnings-ghc
+
+clean:
+	rm -rf src/**/*.{hi,o}
+	rm -rf **/*.{hi,o}
+
+.PHONY: clean
diff --git a/testsuite/tests/driver/t22391/all.T b/testsuite/tests/driver/t22391/all.T
new file mode 100644
index 000000000000..f8a3d2fb3cfb
--- /dev/null
+++ b/testsuite/tests/driver/t22391/all.T
@@ -0,0 +1,5 @@
+test('t22391', [extra_files(['src'])],
+     multimod_compile, ['Lib', '-v1 -Wall -fhide-source-paths -isrc -fdefer-diagnostics'])
+
+test('t22391j', [req_smp, extra_files(['src'])],
+     multimod_compile, ['Lib', '-v1 -Wall -fhide-source-paths -isrc -fdefer-diagnostics -j2'])
diff --git a/testsuite/tests/driver/t22391/src/Lib.hs b/testsuite/tests/driver/t22391/src/Lib.hs
new file mode 100644
index 000000000000..7c43ed04cc5e
--- /dev/null
+++ b/testsuite/tests/driver/t22391/src/Lib.hs
@@ -0,0 +1,11 @@
+module Lib
+    ( someFunc
+    ) where
+
+import Lib.A
+import Lib.B
+
+blah = 3
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"
diff --git a/testsuite/tests/driver/t22391/src/Lib/A.hs b/testsuite/tests/driver/t22391/src/Lib/A.hs
new file mode 100644
index 000000000000..b66d92ccd630
--- /dev/null
+++ b/testsuite/tests/driver/t22391/src/Lib/A.hs
@@ -0,0 +1,3 @@
+module Lib.A where
+
+blast = 1
diff --git a/testsuite/tests/driver/t22391/src/Lib/B.hs b/testsuite/tests/driver/t22391/src/Lib/B.hs
new file mode 100644
index 000000000000..51ba5c2779ff
--- /dev/null
+++ b/testsuite/tests/driver/t22391/src/Lib/B.hs
@@ -0,0 +1,3 @@
+module Lib.B where
+
+warnmeup = 4
diff --git a/testsuite/tests/driver/t22391/t22391.stderr b/testsuite/tests/driver/t22391/t22391.stderr
new file mode 100644
index 000000000000..e24daa51ae92
--- /dev/null
+++ b/testsuite/tests/driver/t22391/t22391.stderr
@@ -0,0 +1,43 @@
+[1 of 3] Compiling Lib.A
+[2 of 3] Compiling Lib.B
+[3 of 3] Compiling Lib
+
+src/Lib/A.hs:3:1: warning: [GHC-38417] [-Wmissing-signatures (in -Wall)]
+    Top-level binding with no type signature: blast :: Integer
+
+src/Lib/A.hs:3:9: warning: [GHC-18042] [-Wtype-defaults (in -Wall)]
+    • Defaulting the type variable ‘a0’ to type ‘Integer’ in the following constraint
+        Num a0 arising from the literal ‘1’
+    • In the expression: 1
+      In an equation for ‘blast’: blast = 1
+
+src/Lib/B.hs:3:1: warning: [GHC-38417] [-Wmissing-signatures (in -Wall)]
+    Top-level binding with no type signature: warnmeup :: Integer
+
+src/Lib/B.hs:3:12: warning: [GHC-18042] [-Wtype-defaults (in -Wall)]
+    • Defaulting the type variable ‘a0’ to type ‘Integer’ in the following constraint
+        Num a0 arising from the literal ‘4’
+    • In the expression: 4
+      In an equation for ‘warnmeup’: warnmeup = 4
+
+src/Lib.hs:5:1: warning: [-Wunused-imports (in -Wextra)]
+    The import of ‘Lib.A’ is redundant
+      except perhaps to import instances from ‘Lib.A’
+    To import instances alone, use: import Lib.A()
+
+src/Lib.hs:6:1: warning: [-Wunused-imports (in -Wextra)]
+    The import of ‘Lib.B’ is redundant
+      except perhaps to import instances from ‘Lib.B’
+    To import instances alone, use: import Lib.B()
+
+src/Lib.hs:8:1: warning: [GHC-38417] [-Wmissing-signatures (in -Wall)]
+    Top-level binding with no type signature: blah :: Integer
+
+src/Lib.hs:8:1: warning: [-Wunused-top-binds (in -Wextra, -Wunused-binds)]
+    Defined but not used: ‘blah’
+
+src/Lib.hs:8:8: warning: [GHC-18042] [-Wtype-defaults (in -Wall)]
+    • Defaulting the type variable ‘a0’ to type ‘Integer’ in the following constraint
+        Num a0 arising from the literal ‘3’
+    • In the expression: 3
+      In an equation for ‘blah’: blah = 3
diff --git a/testsuite/tests/driver/t22391/t22391j.stderr b/testsuite/tests/driver/t22391/t22391j.stderr
new file mode 100644
index 000000000000..e24daa51ae92
--- /dev/null
+++ b/testsuite/tests/driver/t22391/t22391j.stderr
@@ -0,0 +1,43 @@
+[1 of 3] Compiling Lib.A
+[2 of 3] Compiling Lib.B
+[3 of 3] Compiling Lib
+
+src/Lib/A.hs:3:1: warning: [GHC-38417] [-Wmissing-signatures (in -Wall)]
+    Top-level binding with no type signature: blast :: Integer
+
+src/Lib/A.hs:3:9: warning: [GHC-18042] [-Wtype-defaults (in -Wall)]
+    • Defaulting the type variable ‘a0’ to type ‘Integer’ in the following constraint
+        Num a0 arising from the literal ‘1’
+    • In the expression: 1
+      In an equation for ‘blast’: blast = 1
+
+src/Lib/B.hs:3:1: warning: [GHC-38417] [-Wmissing-signatures (in -Wall)]
+    Top-level binding with no type signature: warnmeup :: Integer
+
+src/Lib/B.hs:3:12: warning: [GHC-18042] [-Wtype-defaults (in -Wall)]
+    • Defaulting the type variable ‘a0’ to type ‘Integer’ in the following constraint
+        Num a0 arising from the literal ‘4’
+    • In the expression: 4
+      In an equation for ‘warnmeup’: warnmeup = 4
+
+src/Lib.hs:5:1: warning: [-Wunused-imports (in -Wextra)]
+    The import of ‘Lib.A’ is redundant
+      except perhaps to import instances from ‘Lib.A’
+    To import instances alone, use: import Lib.A()
+
+src/Lib.hs:6:1: warning: [-Wunused-imports (in -Wextra)]
+    The import of ‘Lib.B’ is redundant
+      except perhaps to import instances from ‘Lib.B’
+    To import instances alone, use: import Lib.B()
+
+src/Lib.hs:8:1: warning: [GHC-38417] [-Wmissing-signatures (in -Wall)]
+    Top-level binding with no type signature: blah :: Integer
+
+src/Lib.hs:8:1: warning: [-Wunused-top-binds (in -Wextra, -Wunused-binds)]
+    Defined but not used: ‘blah’
+
+src/Lib.hs:8:8: warning: [GHC-18042] [-Wtype-defaults (in -Wall)]
+    • Defaulting the type variable ‘a0’ to type ‘Integer’ in the following constraint
+        Num a0 arising from the literal ‘3’
+    • In the expression: 3
+      In an equation for ‘blah’: blah = 3
diff --git a/testsuite/tests/ghci/prog018/prog018.stdout b/testsuite/tests/ghci/prog018/prog018.stdout
index da160be432a2..c7b39ad2edf1 100644
--- a/testsuite/tests/ghci/prog018/prog018.stdout
+++ b/testsuite/tests/ghci/prog018/prog018.stdout
@@ -1,4 +1,6 @@
 [1 of 3] Compiling A                ( A.hs, interpreted )
+[2 of 3] Compiling B                ( B.hs, interpreted )
+[3 of 3] Compiling C                ( C.hs, interpreted )
 
 A.hs:5:1: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
@@ -7,19 +9,14 @@ A.hs:5:1: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)]
 
 A.hs:8:15: warning: [-Wunused-matches (in -Wextra)]
     Defined but not used: ‘x’
-[2 of 3] Compiling B                ( B.hs, interpreted )
 
 B.hs:7:1: warning: [-Wunused-imports (in -Wextra)]
     The import of ‘Data.Tuple’ is redundant
       except perhaps to import instances from ‘Data.Tuple’
     To import instances alone, use: import Data.Tuple()
-[3 of 3] Compiling C                ( C.hs, interpreted )
 
 C.hs:6:7: error: [GHC-88464]
     Variable not in scope: variableNotInScope :: ()
 Failed, two modules loaded.
 [3 of 3] Compiling C                ( C.hs, interpreted )
-
-C.hs:6:7: error: [GHC-88464]
-    Variable not in scope: variableNotInScope :: ()
 Failed, two modules loaded.
-- 
GitLab