[Git][ghc/ghc][master] Fix #24308

[Marge Bot (@marge-bot)]

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


Commits:
b2d8cd85 by Matt Walker at 2024-01-26T09:50:08-05:00
Fix #24308

Add tests for semicolon separated where clauses

- - - - -


4 changed files:

- libraries/template-haskell/Language/Haskell/TH/Ppr.hs
- + testsuite/tests/th/T24308.hs
- + testsuite/tests/th/T24308.stdout
- testsuite/tests/th/all.T


Changes:

=====================================
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
=====================================
@@ -395,7 +395,10 @@ instance Ppr Dec where
 ppr_dec :: Bool     -- ^ declaration on the toplevel?
         -> Dec
         -> Doc
-ppr_dec _ (FunD f cs)   = vcat $ map (\c -> pprPrefixOcc f <+> ppr c) cs
+ppr_dec isTop (FunD f cs)   = layout $ map (\c -> pprPrefixOcc f <+> ppr c) cs
+  where
+    layout :: [Doc] -> Doc
+    layout = if isTop then vcat else semiSepWith id
 ppr_dec _ (ValD p r ds) = ppr p <+> pprBody True r
                           $$ where_clause ds
 ppr_dec _ (TySynD t xs rhs)


=====================================
testsuite/tests/th/T24308.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}
+
+module Main where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Ppr
+
+main = runQ t1 >>= (putStrLn . pprint)
+
+t1 = [d|
+      fac n = go n
+       where go 0 = 1
+             go x = x * go (x - 1)
+     |]


=====================================
testsuite/tests/th/T24308.stdout
=====================================
@@ -0,0 +1,2 @@
+fac_0 n_1 = go_2 n_1
+          where {go_2 0 = 1; go_2 x_3 = x_3 GHC.Num.* go_2 (x_3 GHC.Num.- 1)}


=====================================
testsuite/tests/th/all.T
=====================================
@@ -600,3 +600,4 @@ test('T23986', normal, compile_and_run, [''])
 test('T24111', normal, compile_and_run, [''])
 test('T23719', normal, compile_fail, [''])
 test('T24190', normal, compile_and_run, [''])
+test('T24308', normal, compile_and_run, [''])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2d8cd85fa6543f5d424bccadf8824f9b416498c
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/20240126/234bd0f4/attachment-0001.html>