[Git][ghc/ghc][master] Fix pretty printing of WARNING pragmas

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04: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

- - - - -


8 changed files:

- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Unit/Module/Warnings.hs
- testsuite/tests/printer/Makefile
- + testsuite/tests/printer/Test23464.hs
- testsuite/tests/printer/all.T
- + 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
=====================================
@@ -222,10 +222,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)
+    ppr (WarningTxt mcat lsrc ws)
       = case unLoc lsrc of
-          NoSourceText   -> pp_ws ws
-          SourceText src -> ftext src <+> pp_ws ws <+> text "#-}"
+            NoSourceText   -> pp_ws ws
+            SourceText src -> ftext src <+> ctg_doc <+> pp_ws ws <+> text "#-}"
+        where
+          ctg_doc = maybe empty (\ctg -> text "in" <+> doubleQuotes (ppr ctg)) mcat
+
 
     ppr (DeprecatedTxt lsrc  ds)
       = case unLoc lsrc of


=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -790,3 +790,8 @@ Test22765:
 Test22771:
 	$(CHECK_PPR)   $(LIBDIR) Test22771.hs
 	$(CHECK_EXACT) $(LIBDIR) Test22771.hs
+
+.PHONY: Test23464
+Test23465:
+	$(CHECK_PPR)   $(LIBDIR) Test23464.hs
+	$(CHECK_EXACT) $(LIBDIR) Test23464.hs


=====================================
testsuite/tests/printer/Test23464.hs
=====================================
@@ -0,0 +1,4 @@
+module T23465 {-# WaRNING in "x-a" "b" #-} where
+
+{-# WARNInG in "x-c" e "d" #-}
+e = e


=====================================
testsuite/tests/printer/all.T
=====================================
@@ -190,3 +190,4 @@ test('T20531_red_ticks', extra_files(['T20531_defs.hs']), ghci_script, ['T20531_
 test('HsDocTy', [ignore_stderr, req_ppr_deps], makefile_test, ['HsDocTy'])
 test('Test22765', [ignore_stderr, req_ppr_deps], makefile_test, ['Test22765'])
 test('Test22771', [ignore_stderr, req_ppr_deps], makefile_test, ['Test22771'])
+test('Test23464', [ignore_stderr, req_ppr_deps], makefile_test, ['Test23464'])


=====================================
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
=====================================
@@ -66,3 +66,4 @@ 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'])
+test('T23465', normal, compile, ['-ddump-parsed'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/822ef66b54bd48df7c01fcafb99b7694952cae28

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/822ef66b54bd48df7c01fcafb99b7694952cae28
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/20230725/ac2c47d6/attachment-0001.html>