[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:
02758825 by Matthew Pickering at 2023-06-06T17:30:53+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/0275882551e9a2fc8c79378cd377fc91c2acc079

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0275882551e9a2fc8c79378cd377fc91c2acc079
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/a5da21f0/attachment-0001.html>