From 2be99b7e81e2ae5ef81fef21b0a55cfe77f917a3 Mon Sep 17 00:00:00 2001
From: Matthew Pickering <matthewtpickering@gmail.com>
Date: Wed, 28 Jun 2023 20:26:30 +0100
Subject: [PATCH] Fix deprecation warning when deprecated identifier is from
 another module

A stray 'Just' was being printed in the deprecation message.

Fixes #23573
---
 compiler/GHC/Tc/Errors/Ppr.hs                         | 7 +++++--
 testsuite/tests/warnings/should_compile/T23573.hs     | 5 +++++
 testsuite/tests/warnings/should_compile/T23573.stderr | 5 +++++
 testsuite/tests/warnings/should_compile/T23573A.hs    | 5 +++++
 testsuite/tests/warnings/should_compile/T23573B.hs    | 4 ++++
 testsuite/tests/warnings/should_compile/all.T         | 1 +
 6 files changed, 25 insertions(+), 2 deletions(-)
 create mode 100644 testsuite/tests/warnings/should_compile/T23573.hs
 create mode 100644 testsuite/tests/warnings/should_compile/T23573.stderr
 create mode 100644 testsuite/tests/warnings/should_compile/T23573A.hs
 create mode 100644 testsuite/tests/warnings/should_compile/T23573B.hs

diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 266290ccb620..6c875434a695 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -1099,8 +1099,11 @@ instance Diagnostic TcRnMessage where
           , pprWarningTxtForMsg pragma_warning_msg ]
           where
             impMsg  = text "imported from" <+> ppr pragma_warning_import_mod <> extra
-            extra | maybe True (pragma_warning_import_mod ==) pragma_warning_defined_mod = empty
-                  | otherwise = text ", but defined in" <+> ppr pragma_warning_defined_mod
+            extra = case pragma_warning_defined_mod of
+                      Just def_mod
+                        | def_mod /= pragma_warning_import_mod
+                          -> text ", but defined in" <+> ppr def_mod
+                      _ -> empty
     TcRnDifferentExportWarnings name locs
       -> mkSimpleDecorated $ vcat [quotes (ppr name) <+> text "exported with different error messages",
                                    text "at" <+> vcat (map ppr $ sortBy leftmost_smallest $ NE.toList locs)]
diff --git a/testsuite/tests/warnings/should_compile/T23573.hs b/testsuite/tests/warnings/should_compile/T23573.hs
new file mode 100644
index 000000000000..a73fd28aa7fb
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T23573.hs
@@ -0,0 +1,5 @@
+module T23573 where
+
+import T23573A
+
+foo = deprec
diff --git a/testsuite/tests/warnings/should_compile/T23573.stderr b/testsuite/tests/warnings/should_compile/T23573.stderr
new file mode 100644
index 000000000000..1f44f590ada8
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T23573.stderr
@@ -0,0 +1,5 @@
+
+T23573.hs:5:7: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+    In the use of ‘deprec’
+    (imported from T23573A, but defined in T23573B):
+    Deprecated: "deprec"
diff --git a/testsuite/tests/warnings/should_compile/T23573A.hs b/testsuite/tests/warnings/should_compile/T23573A.hs
new file mode 100644
index 000000000000..73af48fdc9a6
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T23573A.hs
@@ -0,0 +1,5 @@
+module T23573A(module T23573B) where
+
+import T23573B
+
+
diff --git a/testsuite/tests/warnings/should_compile/T23573B.hs b/testsuite/tests/warnings/should_compile/T23573B.hs
new file mode 100644
index 000000000000..fdb3a570fc20
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T23573B.hs
@@ -0,0 +1,4 @@
+module T23573B where
+
+{-# DEPRECATED deprec "deprec" #-}
+deprec = ()
diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T
index cb6e7ac11c0f..1891470da71b 100644
--- a/testsuite/tests/warnings/should_compile/all.T
+++ b/testsuite/tests/warnings/should_compile/all.T
@@ -65,3 +65,4 @@ test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports'])
 test('T22702a', normal, compile, [''])
 test('T22702b', normal, compile, [''])
 test('T22826', normal, compile, [''])
+test('T23573', [extra_files(["T23573.hs", "T23573A.hs", "T23573B.hs"])], multimod_compile, ['T23573', '-v0'])
-- 
GitLab