[Git][ghc/ghc][wip/t24631] driver: Use correct DynFlags when emitting unecessary source pragma warning

[Matthew Pickering (@mpickering)]

Matthew Pickering pushed to branch wip/t24631 at Glasgow Haskell Compiler / GHC


Commits:
256dabce by Matthew Pickering at 2024-04-10T10:29:31+01:00
driver: Use correct DynFlags when emitting unecessary source pragma warning

We were using the global DynFlags in order to determine whether to emit
the unecessary source imports warning, instead we should use the
per-module DynFlags so that local GHC_OPTIONS are honoured.

Fixes #24631

- - - - -


5 changed files:

- compiler/GHC/Driver/Make.hs
- + testsuite/tests/driver/T24631.hs
- + testsuite/tests/driver/T24631A.hs
- + testsuite/tests/driver/T24631A.hs-boot
- testsuite/tests/driver/all.T


Changes:

=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1516,17 +1516,15 @@ modNodeMapUnionWith f (ModNodeMap m) (ModNodeMap n) = ModNodeMap (M.unionWith f
 -- were necessary, then the edge would be part of a cycle.
 warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()
 warnUnnecessarySourceImports sccs = do
-  diag_opts <- initDiagOpts <$> getDynFlags
-  when (diag_wopt Opt_WarnUnusedImports diag_opts) $ do
-    let check ms =
-           let mods_in_this_cycle = map ms_mod_name ms in
-           [ warn i | m <- ms, i <- ms_home_srcimps m,
-                      unLoc i `notElem`  mods_in_this_cycle ]
-
-        warn :: Located ModuleName -> MsgEnvelope GhcMessage
-        warn (L loc mod) = GhcDriverMessage <$> mkPlainMsgEnvelope diag_opts
+  let check ms =
+         let mods_in_this_cycle = map ms_mod_name ms in
+         [ warn i (ms_hspp_opts m) | m <- ms, i <- ms_home_srcimps m,
+                    unLoc i `notElem`  mods_in_this_cycle ]
+
+      warn :: Located ModuleName -> DynFlags -> MsgEnvelope GhcMessage
+      warn (L loc mod) dflags = GhcDriverMessage <$> mkPlainMsgEnvelope (initDiagOpts dflags)
                                                   loc (DriverUnnecessarySourceImports mod)
-    logDiagnostics (mkMessages $ listToBag (concatMap (check . flattenSCC) sccs))
+  logDiagnostics (mkMessages $ listToBag (concatMap (check . flattenSCC) sccs))
 
 
 -- This caches the answer to the question, if we are in this unit, what does


=====================================
testsuite/tests/driver/T24631.hs
=====================================
@@ -0,0 +1,4 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+module T24361 where
+
+import {-# SOURCE #-} T24631A


=====================================
testsuite/tests/driver/T24631A.hs
=====================================
@@ -0,0 +1 @@
+module T24631A where


=====================================
testsuite/tests/driver/T24631A.hs-boot
=====================================
@@ -0,0 +1 @@
+module T24631A where


=====================================
testsuite/tests/driver/all.T
=====================================
@@ -327,3 +327,4 @@ test('T23339B', [extra_files(['T23339.hs']), req_c], makefile_test, [])
 test('T23613', normal, compile_and_run, ['-this-unit-id=foo'])
 test('T23944', [unless(have_dynamic(), skip), extra_files(['T23944A.hs'])], multimod_compile, ['T23944 T23944A', '-fprefer-byte-code -fbyte-code -fno-code -dynamic-too -fwrite-interface'])
 test('T24286', [cxx_src, unless(have_profiling(), skip), extra_files(['T24286.cpp'])], compile, ['-prof -no-hs-main'])
+test('T24631', [extra_files(['T24631A.hs', 'T24631A.hs-boot'])], multimod_compile, ['T24631', '-v0 -Wall -Werror'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/256dabce741db7b3c458b1a740bc868429c06cec

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/256dabce741db7b3c458b1a740bc868429c06cec
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/20240410/a0b15b64/attachment-0001.html>