[Git][ghc/ghc][wip/t23465] Fix pretty printing of WARNING pragmas

[Matthew Pickering (@mpickering)]

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


Commits:
5c33fa18 by Matthew Pickering at 2023-06-06T17:29:56+01:00
Fix pretty printing of WARNING pragmas

There is still something quite unsavoury going on with WARNING pragma
printing because the printing relies on the fact that for decl
deprecations the SourceText of WarningTxt is empty. However, I let that
lion sleep and just fixed things directly.

Fixes #23465

- - - - -


5 changed files:

- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Unit/Module/Warnings.hs
- + testsuite/tests/warnings/should_compile/T23465.hs
- + testsuite/tests/warnings/should_compile/T23465.stderr
- testsuite/tests/warnings/should_compile/all.T


Changes:

=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -1234,7 +1234,7 @@ instance OutputableBndrId p
               <+> ppr txt
       where
         ppr_category = case txt of
-                         WarningTxt (Just cat) _ _ -> text "[" <> ppr (unLoc cat) <> text "]"
+                         WarningTxt (Just cat) _ _ -> text "in" <+> doubleQuotes (ppr cat)
                          _ -> empty
 
 {-


=====================================
compiler/GHC/Unit/Module/Warnings.hs
=====================================
@@ -193,10 +193,13 @@ deriving instance Eq (IdP pass) => Eq (WarningTxt pass)
 deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass)
 
 instance Outputable (WarningTxt pass) where
-    ppr (WarningTxt _ lsrc ws)
-      = case unLoc lsrc of
-          NoSourceText   -> pp_ws ws
-          SourceText src -> ftext src <+> pp_ws ws <+> text "#-}"
+    ppr (WarningTxt mcat lsrc ws)
+      = let
+          cat = maybe empty (\cat -> text "in" <+> doubleQuotes (ppr cat)) mcat
+        in case unLoc lsrc of
+            NoSourceText   -> pp_ws ws
+            SourceText src -> ftext src <+> cat <+> pp_ws ws <+> text "#-}"
+
 
     ppr (DeprecatedTxt lsrc  ds)
       = case unLoc lsrc of


=====================================
testsuite/tests/warnings/should_compile/T23465.hs
=====================================
@@ -0,0 +1,4 @@
+module T23465 {-# WARNING in "x-a" "b" #-} where
+
+{-# WARNING in "x-c" e "d" #-}
+e = e


=====================================
testsuite/tests/warnings/should_compile/T23465.stderr
=====================================
@@ -0,0 +1,9 @@
+
+==================== Parser ====================
+module T23465
+{-# WARNING in "x-a" "b" #-}
+where
+{-# WARNING in "x-c" e "d" #-}
+e = e
+
+


=====================================
testsuite/tests/warnings/should_compile/all.T
=====================================
@@ -62,5 +62,4 @@ test('T22759', normal, compile, [''])
 test('T22676', [extra_files(['src'])], multimod_compile, ['src.hs', '-working-dir src -Wmissing-home-modules -v0'])
 test('DodgyImports', normal, compile, ['-Wdodgy-imports'])
 test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports'])
-test('T22702a', normal, compile, [''])
-test('T22702b', normal, compile, [''])
+test('T23465', normal, compile, ['-ddump-parsed'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c33fa1850eddb9dbb788d7daf7106d1377dbeeb

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c33fa1850eddb9dbb788d7daf7106d1377dbeeb
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/20230606/f25f655a/attachment-0001.html>